home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_FileRunner.idb / usr / freeware / lib / FileRunner2.5 / fr.z / fr
Encoding:
Text File  |  1999-01-26  |  108.8 KB  |  3,353 lines

  1. #! /bin/sh
  2. # -*- tcl -*- \
  3. exec wish8.0 $0 wish8.0 $*
  4.  
  5. set glob(version) 2.5
  6.  
  7. proc bgerror err {
  8.   global errorInfo env glob tcl_patchLevel tk_patchLevel
  9.   set info $errorInfo
  10.   set button [tk_dialog .bgerrorDialog "Fatal error in Tcl Script" \
  11.                   "You have found a bug. It might be in FileRunner.\n\n$err\n\nPlease send a bugreport to the author." \
  12.                   error 0 "Exit" "See Stack Trace" "Prepare bugreport"]
  13.   if {$button == 0} {
  14.     exit 1
  15.   }
  16.   if {$button == 2} {
  17.     set r [catch {open $env(HOME)/filerunner_bugreport w} fid]
  18.     if {$r} { tk_dialog .bugrepinfo "Error" "Can't create file $env(HOME)/filerunner_bugreport to dump bugreport\n$fid" "" 0 "Exit" ; exit 1}
  19.     puts $fid "\nBugreport for FileRunner version $glob(version) created [clock format [clock seconds]].\n"
  20.     puts $fid "Please fill in/correct the rest of this and send it to hch@cd.chalmers.se or Henrik.Harmsen@erv.ericsson.se.\n\n"
  21.     set r [catch { exec uname -a } output]
  22.     if {$r} { set output "" }
  23.     puts $fid "Operating System : $output"
  24.     puts $fid "Tcl/Tk version   : $tcl_patchLevel / $tk_patchLevel"
  25.     puts $fid "Comments         : "
  26.     puts $fid "\nError string : $err"
  27.     puts $fid "\nStack trace follows:\n--------------------\n$info"
  28.     catch {close $fid}
  29.     tk_dialog .bugrepinfo "Error" "Bugreport file saved to\n$env(HOME)/filerunner_bugreport. Please fill in the rest of it and send it to the author." "" 0 "Exit"
  30.     exit 1
  31.   }
  32.  
  33.   set w .bgerrorTrace
  34.   catch {destroy $w}
  35.   toplevel $w -class ErrorTrace
  36.   wm protocol $w WM_DELETE_WINDOW { exit 1 }
  37.   wm minsize $w 1 1
  38.   wm title $w "Stack Trace for Error"
  39.   wm iconname $w "Stack Trace"
  40.   button $w.ok -text Exit -command "exit 1"
  41.   text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
  42.       -setgrid true -width 60 -height 20
  43.   scrollbar $w.scroll -relief sunken -command "$w.text yview"
  44.   pack $w.ok -side bottom -padx 3m -pady 2m
  45.   pack $w.scroll -side right -fill y
  46.   pack $w.text -side left -expand yes -fill both
  47.   $w.text insert 0.0 $info
  48.   $w.text mark set insert 0.0
  49.  
  50.   # Center the window on the screen.
  51.  
  52.   wm withdraw $w
  53.   update idletasks
  54.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  55.              - [winfo vrootx [winfo parent $w]]]
  56.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  57.              - [winfo vrooty [winfo parent $w]]]
  58.   wm geom $w +$x+$y
  59.   wm deiconify $w
  60.  
  61.   # Be sure to release any grabs that might be present on the
  62.   # screen, since they could make it impossible for the user
  63.   # to interact with the stack trace.
  64.  
  65.   if {[grab current .] != ""} {
  66.     grab release [grab current .]
  67.   }
  68. }
  69.  
  70. proc ShowWindow {} {
  71.   global glob tk_version argv argv0 config env win
  72.  
  73.   wm positionfrom . user
  74.   wm sizefrom . ""
  75.   wm title . "FileRunner  v$glob(version)"
  76.   wm geometry . $config(geometry,main)
  77.   wm protocol . WM_DELETE_WINDOW { CleanUp 0 }
  78.   wm iconname . "FileRunner v$glob(version)"
  79.  
  80.   frame .fupper -bd 0
  81.   frame .flower -bd 0
  82.   frame $glob(win,top) -borderwidth 2 -relief raised
  83.  
  84.   frame $glob(win,top).menu_frame
  85.  
  86.   menubutton $glob(win,top).menu_frame.file_but -menu $glob(win,top).menu_frame.file_but.m -text File
  87.   menubutton $glob(win,top).menu_frame.configuration_but -menu $glob(win,top).menu_frame.configuration_but.m -text Configuration
  88.   menubutton $glob(win,top).menu_frame.utils_but -menu $glob(win,top).menu_frame.utils_but.m -text Utilities
  89.   menubutton $glob(win,top).menu_frame.help_but -menu $glob(win,top).menu_frame.help_but.m -text Help
  90.   frame $glob(win,top).menu_frame.fasync_cmds -bd 0
  91.   button $glob(win,top).menu_frame.fasync_cmds.abort -borderwidth 1 -text Stop -command { set glob(abortcmd) 1 }
  92.   button $glob(win,top).menu_frame.fasync_cmds.clone -borderwidth 1 -text Clone -command Clone
  93.  
  94.   # Create FILE menu
  95.   menu $glob(win,top).menu_frame.file_but.m -tearoff false
  96.   $glob(win,top).menu_frame.file_but.m add command -label About... -command About
  97.   $glob(win,top).menu_frame.file_but.m add command -label "View Log..." -command { ViewString "Log" glob(log) $env(HOME)/filerunner.log }
  98.   $glob(win,top).menu_frame.file_but.m add command -label Quit -command { CleanUp 0 }
  99.  
  100.   # Create CONFIGURATION menu
  101.   menu $glob(win,top).menu_frame.configuration_but.m -tearoff false 
  102.   $glob(win,top).menu_frame.configuration_but.m add command -label {Save Configuration} -command SaveConfig
  103.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Configuration...} -command ConfigBrowser
  104.   $glob(win,top).menu_frame.configuration_but.m add command -label {Reread Configuration} -command {
  105.       ReadConfig;UpdateWindow both;Log "Configuration re-read"
  106.     }
  107.   $glob(win,top).menu_frame.configuration_but.m add separator
  108.   $glob(win,top).menu_frame.configuration_but.m add check -label "Show All Files" -variable config(fileshow,all) -command ForceUpdate
  109.   $glob(win,top).menu_frame.configuration_but.m add check -label "Create Relative Links" -variable config(create_relative_links) 
  110.   $glob(win,top).menu_frame.configuration_but.m add check -label "Run Pwd After Cd" -variable config(cd_pwd) 
  111.   $glob(win,top).menu_frame.configuration_but.m add check -label "Run Pwd After Cd (FTP)" -variable config(ftp,cd_pwd) 
  112.   $glob(win,top).menu_frame.configuration_but.m add check -label "Anonymous FTP" -variable config(ftp,anonymous) 
  113.   $glob(win,top).menu_frame.configuration_but.m add check -label "Use FTP Proxy" -variable config(ftp,useproxy) 
  114.   $glob(win,top).menu_frame.configuration_but.m add separator
  115.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort On Name" -variable config(fileshow,sort) -value nameonly -command ForceUpdate
  116.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort Dirs First" -variable config(fileshow,sort) -value dirsfirst -command ForceUpdate
  117.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort Dirs Last" -variable config(fileshow,sort) -value dirslast -command ForceUpdate
  118.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort On Time" -variable config(fileshow,sort) -value time -command ForceUpdate
  119.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort On Reverse Time" -variable config(fileshow,sort) -value rtime -command ForceUpdate
  120.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort On Size" -variable config(fileshow,sort) -value size -command ForceUpdate
  121.   $glob(win,top).menu_frame.configuration_but.m add radio -label "Sort On Extension" -variable config(fileshow,sort) -value extension -command ForceUpdate
  122.   $glob(win,top).menu_frame.configuration_but.m add separator
  123.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Entry BG Color...} -command "EditColor color_bg"
  124.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Entry FG Color...} -command "EditColor color_fg"
  125.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Selection BG Color...} -command "EditColor color_select_bg"
  126.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Selection FG Color...} -command "EditColor color_select_fg"
  127.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Shell Cmd Color...} -command "EditColor color_cmd"
  128.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Scheme Color...} -command "EditColor color_scheme"
  129.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Cursor Color...} -command "EditColor color_cursor"
  130.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Entry Font...} -command "EditFont font"
  131.   $glob(win,top).menu_frame.configuration_but.m add command -label {Edit Scheme Font...} -command "EditFont font_scheme"
  132.   $glob(win,top).menu_frame.configuration_but.m add separator
  133.   $glob(win,top).menu_frame.configuration_but.m add command -label {Set Left Start Dir} -command "DoProtCmd \"SetStartDir left\""
  134.   $glob(win,top).menu_frame.configuration_but.m add command -label {Set Right Start Dir} -command "DoProtCmd \"SetStartDir right\""
  135.   $glob(win,top).menu_frame.configuration_but.m add command -label {Set Window Pos/Size} -command "SetWinPos"
  136.  
  137.   # Create Utilities menu
  138.   menu $glob(win,top).menu_frame.utils_but.m -tearoff false 
  139.   $glob(win,top).menu_frame.utils_but.m add command -label {Swap Windows} -command "DoProtCmd CmdSwapWindows"
  140.   $glob(win,top).menu_frame.utils_but.m add command -label {View As Text} -command "DoProtCmd CmdViewAsText"
  141.   $glob(win,top).menu_frame.utils_but.m add command -label {What Is?...} -command "DoProtCmd CmdWhatIs"
  142.   $glob(win,top).menu_frame.utils_but.m add command -label {Select On Contents...} -command "DoProtCmd CmdCSelect"
  143.   $glob(win,top).menu_frame.utils_but.m add command -label {Run Command On Selected...} -command "DoProtCmd CmdRunCmd"
  144.   $glob(win,top).menu_frame.utils_but.m add command -label {Check Size Of Selected...} -command "DoProtCmd CmdCheckSize"
  145.   $glob(win,top).menu_frame.utils_but.m add command -label {FTP Copy With Resume} -command {DoProtCmd {CmdCopy 1}}
  146.   $glob(win,top).menu_frame.utils_but.m add command -label {FTP Copy With Resume/Async} -command {set glob(async) 1; DoProtCmd {CmdCopy 1}; set glob(async) 0}
  147.  
  148.   # Create Help menu
  149.   menu $glob(win,top).menu_frame.help_but.m -tearoff false 
  150.   $glob(win,top).menu_frame.help_but.m add command -label {QuickStart} -command   { ViewText $glob(doclib_fr)/QuickStart.txt }
  151.   $glob(win,top).menu_frame.help_but.m add command -label {User's Guide} -command { ViewText $glob(doclib_fr)/Users_Guide.txt }
  152.   $glob(win,top).menu_frame.help_but.m add command -label {Copying} -command { ViewText $glob(doclib_fr)/COPYING }
  153.   $glob(win,top).menu_frame.help_but.m add command -label {History} -command   { ViewText $glob(doclib_fr)/HISTORY }
  154.   $glob(win,top).menu_frame.help_but.m add command -label {Installation} -command   { ViewText $glob(doclib_fr)/README }
  155.   $glob(win,top).menu_frame.help_but.m add command -label {FAQ} -command   { ViewText $glob(doclib_fr)/FAQ }
  156.   $glob(win,top).menu_frame.help_but.m add command -label {Tips} -command   { ViewText $glob(doclib_fr)/Tips.txt }
  157.   $glob(win,top).menu_frame.help_but.m add command -label {Known Bugs} -command   { ViewText $glob(doclib_fr)/KnownBugs.txt }
  158.  
  159.   pack $glob(win,top).menu_frame.file_but $glob(win,top).menu_frame.configuration_but $glob(win,top).menu_frame.utils_but \
  160.     $glob(win,top).menu_frame.fasync_cmds -side left
  161.   pack $glob(win,top).menu_frame.fasync_cmds.clone $glob(win,top).menu_frame.fasync_cmds.abort -side left
  162.   pack $glob(win,top).menu_frame.help_but -side right
  163.  
  164.   label $glob(win,top).menu_frame.clock -text "[Time]      "
  165.   pack $glob(win,top).menu_frame.clock -side right
  166.  
  167.   if {[GetEuid] == 0} {
  168.     label $glob(win,top).menu_frame.user -text "root@$env(HOST)  "
  169.   } else {
  170.     label $glob(win,top).menu_frame.user -text "$env(USER)@$env(HOST)  "
  171.   }
  172.   pack $glob(win,top).menu_frame.user -side right
  173.  
  174.   label $glob(win,top).status -relief groove -bd 2 -text {}
  175.  
  176.   pack $glob(win,top).menu_frame $glob(win,top).status -side top -fill x
  177.  
  178.   BuildFileListPanel left
  179.   BuildFileListPanel right
  180.  
  181.  
  182.   set darkcol [$glob(win,left).frame_listb.scroll_horiz cget -troughcolor]
  183.  
  184.   # build widget .fm
  185.   frame $glob(win,middle) -borderwidth 2 -relief raised 
  186. #-bg $darkcol
  187.  
  188.   set glob(cmds,list)  { 
  189.     { { ->      CmdToright } { <-      CmdToleft } }
  190.     { Copy      CmdCopy c 0 } 
  191.     { CopyAs    CmdCopyAs "" 0 } 
  192.     { Delete    CmdDelete d 0 }
  193.     { Move      CmdMove m 0 }
  194.     { Rename    CmdRename r 0 }
  195.     { MkDir     CmdMakeDir "" 0 } 
  196.     { S-Link    CmdSoftLink s 0 } 
  197.     { S-LnAs    CmdSoftLinkAs "" 0 } 
  198.     { Chmod     CmdChmod h 1 } 
  199.     { View      CmdView v 0 } 
  200.     { Edit      CmdEdit e 0 } 
  201.     { Q-Edit    CmdQEdit q 0 } 
  202.     { Arc       CmdArc a 0 } 
  203.     { UnArc     CmdUnArc u 0 } 
  204.     { UnPack    CmdUnPack p 2 } 
  205.     { ForEach   CmdForEach "" 0 } 
  206.     { Print     CmdPrint "" 0 } 
  207.     { Diff      CmdDiff f 2 } 
  208.     { Select    CmdSelect "" 0 } 
  209.   }
  210.  
  211. # moved    { C-Select  CmdCSelect } 
  212. # moved    { RunCmd    CmdRunCmd } 
  213.  
  214.   set foo {}
  215.   foreach k $config(usercommands) {
  216.     lappend foo [list [lindex $k 0] [list DoUsrCmd [lindex $k 1]]]
  217.   }
  218.  
  219.   set glob(cmds,list) "$glob(cmds,list) $foo"
  220.  
  221.   set glob(cmds,cur) 0
  222.  
  223.   frame $glob(win,middle).top -borderwidth 0 -relief raised
  224.   button $glob(win,middle).top.up -bitmap @$glob(lib_fr)/bitmaps/pgup.bit -command "ShowCmds up"
  225.   button $glob(win,middle).top.down -bitmap @$glob(lib_fr)/bitmaps/pgdown.bit -command "ShowCmds down"
  226.   pack $glob(win,middle).top -side top -fill x
  227.   pack $glob(win,middle).top.up -side left -expand 1 -fill both
  228.   pack $glob(win,middle).top.down -side right -expand 1 -fill both
  229.  
  230.   set n 0
  231.   foreach c $glob(cmds,list) {
  232.     if {$n == 0} {
  233.       frame $glob(win,middle).$n -bd 0
  234.       button $glob(win,middle).$n.1 -bitmap @$glob(lib_fr)/bitmaps/right.bit -command "DoProtCmd [lindex [lindex $c 0] 1]"
  235.       button $glob(win,middle).$n.2 -bitmap @$glob(lib_fr)/bitmaps/left.bit -command "DoProtCmd [lindex [lindex $c 1] 1]"
  236.       pack $glob(win,middle).$n.2 -side left -expand 1 -fill x
  237.       pack $glob(win,middle).$n.1 -side right -expand 1 -fill x
  238.       pack $glob(win,middle).$n -side top -fill x
  239.     } else {
  240.       set text [lindex $c 0]
  241.       button $glob(win,middle).$n -text $text -command "set glob(mbutton) 1; DoProtCmd \"[lindex $c 1]\"" 
  242.       foreach colentry $config(middle_button_colors) {
  243.         set name [lindex $colentry 0]
  244.         set col [lindex $colentry 1]
  245.         if { $text == $name } {
  246.           if { [string index $col 0] == "-" } {
  247.             $glob(win,middle).$n configure -activebackground [string range $col 1 end]
  248.           } else {
  249.             $glob(win,middle).$n configure -background $col -activebackground [LighterColor $col]
  250.           }
  251.         }
  252.       }
  253.       if {[lindex $c 2] != "" && $config(keyb_support)} {
  254.         $glob(win,middle).$n configure -underline [lindex $c 3]
  255.       }
  256.       bind $glob(win,middle).$n <3> "set glob(mbutton) 2; set glob(async) 1; DoProtCmd \"[lindex $c 1]\"; set glob(async) 0"
  257.       bind $glob(win,middle).$n <2> "set glob(mbutton) 3; DoProtCmd \"[lindex $c 1]\""
  258.       pack $glob(win,middle).$n -side top -fill x
  259.     }
  260.     incr n
  261.   }
  262.  
  263.   # Build command windows
  264.   BuildCmdWindow left
  265.   BuildCmdWindow right
  266.  
  267.   pack .fupper -side top -fill both -expand 1
  268.   pack .flower -side bottom -expand 1 -fill both
  269.   pack $glob(win,top) -side top -fill both
  270.   pack $glob(win,left) -side left -expand 1 -fill both
  271.   pack $glob(win,right) -side right -expand 1 -fill both
  272.   pack $glob(win,middle) -side top -expand 1 -fill y
  273.   pack propagate .fupper 0
  274.   pack forget $glob(win,bottom)
  275. }
  276.  
  277.  
  278. proc FontDialog { } {
  279.   global glob config
  280.  
  281.   set w .font_dialog
  282.   toplevel $w -class Dialog
  283.   wm title $w "Font Chooser"
  284.   wm iconname $w "Font Chooser"
  285.   wm resizable $w true true
  286.   wm transient $w [winfo toplevel [winfo parent $w]]
  287.  
  288.   frame $w.top
  289.   frame $w.bot
  290.   scrollbar $w.top.scrollvert -command "$w.top.list yview" -orient vertical 
  291.   scrollbar $w.top.scrollhoriz -command "$w.top.list xview" -orient horizontal 
  292.   listbox $w.top.list \
  293.     -yscrollcommand "$w.top.scrollvert set" \
  294.     -xscrollcommand "$w.top.scrollhoriz set" \
  295.     -font $config(gui,font) \
  296.     -background $config(gui,color_bg) -foreground $config(gui,color_fg) \
  297.     -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg) \
  298.     -width 70 \
  299.     -height 30 
  300.   button $w.bot.ok -text OK -command "FontDialogOK $w; destroy $w"
  301.   button $w.bot.cancel -text Cancel -command "set glob(font_dialog_return) {}; destroy $w"
  302.   label $w.top.example -text "AaBbCcDdEeFfGgHhIiJjKk 0123456789" -bg White -fg Black
  303.  
  304.   set r [catch {exec xlsfonts} glob(font_dialog,fl)]
  305. #  set glob(font_dialog,fl) {screen-14 screen-12}
  306. #  set r 0
  307.   if {$r} {
  308.     PopError "Can't get fontlist from server ($glob(font_dialog,fl))"
  309.     destroy $w
  310.     return ""
  311.   }
  312.  
  313.   $w.top.list delete 0 end
  314.   set glob(font_dialog,fl) [split $glob(font_dialog,fl) "\n"]
  315.   eval $w.top.list insert end $glob(font_dialog,fl)
  316.  
  317.   pack $w.top -side top -expand 1 -fill both
  318.   pack $w.top.example -side bottom -fill x
  319.   pack $w.top.scrollvert -side right -fill y
  320.   pack $w.top.scrollhoriz -side bottom -fill x
  321.   pack $w.top.list -side top -expand 1 -fill both
  322.   pack $w.bot -side bottom
  323.   pack $w.bot.cancel -side right
  324.   pack $w.bot.ok -side right
  325.  
  326.   set glob(font_dialog_return) {}
  327.  
  328.   wm withdraw $w
  329.   update idletasks
  330.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  331.           - [winfo vrootx [winfo parent $w]]]
  332.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  333.           - [winfo vrooty [winfo parent $w]]]
  334.   wm geom $w +$x+$y
  335.   wm deiconify $w
  336.  
  337.   bind $w.top.list <1> "
  338.     $w.top.example configure -font \"\[lindex \$glob(font_dialog,fl) \[$w.top.list nearest %y\]\]\"
  339.   "
  340.  
  341.   set oldGrab [grab current $w]
  342.   frgrab $w
  343.   set oldena $glob(enableautoupdate)
  344.   set glob(enableautoupdate) 0
  345.   tkwait window $w
  346.   if {$oldGrab != ""} {
  347.     frgrab $oldGrab
  348.   }
  349.   set glob(enableautoupdate) $oldena
  350.   unset glob(font_dialog,fl)
  351.   return $glob(font_dialog_return)
  352. }
  353.  
  354. proc FontDialogOK { w } {
  355.   global glob
  356.   set idx [$w.top.list curselection]
  357.   if {$idx != ""} {
  358.     set glob(font_dialog_return) "[lindex $glob(font_dialog,fl) $idx]"
  359.   }
  360. }
  361.  
  362. proc EditFont { font } {
  363.   global config glob
  364.   set c $config(gui,$font)
  365.   set out [FontDialog]
  366.   if {$out == ""} return
  367.   set config(gui,$font) $out
  368.   ReConfigFont
  369. }
  370.  
  371.  
  372. proc EditColor { color } {
  373.   global config glob
  374.   set c $config(gui,$color)
  375.   if {$c == ""} {set c grey85}
  376.   set r [catch {exec $glob(lib_fr)/frcolor $c} out]
  377.   if {$r} {PopError $out}
  378.   if {$out == ""} return
  379.   set config(gui,$color) $out
  380.   ReConfigColors 
  381. }
  382.  
  383. proc ReConfigFont {} {
  384.   global glob config
  385.   if {$config(gui,font_scheme) != "" && $config(gui,font_scheme) != $glob(gui,font_scheme)} {
  386.     catch {tk_setFont $config(gui,font_scheme)} out
  387.     set glob(gui,font_scheme) $config(gui,font_scheme)
  388.   }
  389.   if {$config(gui,font) != $glob(gui,font)} {
  390.     foreach k $glob(gui,color_xx,winlist) {
  391.       catch {$k configure -font $config(gui,font)}
  392.     }
  393.     set glob(gui,font) $config(gui,font)
  394.   }
  395. }
  396.  
  397. # Produce a color suitable for active-backgrounds
  398. proc LighterColor { color } {
  399.   set color [winfo rgb . $color]
  400.   foreach i {0 1 2} {
  401.     set light($i) [expr [lindex $color $i]/256]
  402.     set inc1 [expr ($light($i)*15)/100]
  403.     set inc2 [expr (255-$light($i))/3]
  404.     if {$inc1 > $inc2} {
  405.       incr light($i) $inc1
  406.     } else {
  407.       incr light($i) $inc2
  408.     }
  409.     if {$light($i) > 255} {
  410.       set light($i) 255
  411.     }
  412.   }
  413.   return [format #%02x%02x%02x $light(0) $light(1) $light(2)]
  414. }
  415.  
  416. proc ReConfigColors { } {
  417.   global glob config
  418.   if {$config(gui,color_scheme) != $glob(gui,color_scheme) || $config(gui,color_cursor) != $glob(gui,color_cursor)} {
  419.     catch {tk_setPalette background $config(gui,color_scheme) insertBackground $config(gui,color_cursor)} out
  420.     set glob(gui,color_scheme) $config(gui,color_scheme)
  421.     set glob(gui,color_cursor) $config(gui,color_cursor)
  422.   }
  423.   foreach c { color_bg color_fg color_select_bg color_select_fg } {
  424.     if {$config(gui,$c) != $glob(gui,$c)} {
  425.       foreach k $glob(gui,color_xx,winlist) {
  426.         switch $c {
  427.           color_bg { $k configure -bg $config(gui,$c) }
  428.           color_fg { $k configure -fg $config(gui,$c) }
  429.           color_select_fg { $k configure -selectforeground $config(gui,$c) }
  430.           color_select_bg { $k configure -selectbackground $config(gui,$c) }
  431.         }
  432.       }
  433.       set glob(gui,$c) $config(gui,$c)
  434.     }
  435.   }
  436.   if {$config(gui,color_cmd) != $glob(gui,color_cmd)} {
  437.     foreach k $glob(gui,color_cmd,winlist) {
  438.       $k tag configure command -background $config(gui,color_cmd)
  439.     }
  440.     set glob(gui,color_cmd) $config(gui,color_cmd)
  441.   }
  442. }
  443.  
  444. proc FindDialog { result inst } {
  445.   global glob config
  446.  
  447.   incr glob(toplevelidx)  
  448.   set w .toplevel_$glob(toplevelidx)
  449.   toplevel $w -class Dialog
  450.   wm title $w "Files Found"
  451.   wm iconname $w "Files Found"
  452.   wm resizable $w true true
  453.   wm transient $w [winfo toplevel [winfo parent $w]]
  454.  
  455.   frame $w.top
  456.   frame $w.bot
  457.   scrollbar $w.top.scrollvert -command "$w.top.list yview" -orient vertical 
  458.   scrollbar $w.top.scrollhoriz -command "$w.top.list xview" -orient horizontal 
  459.   listbox $w.top.list \
  460.     -yscrollcommand "$w.top.scrollvert set" \
  461.     -xscrollcommand "$w.top.scrollhoriz set" \
  462.     -font $config(gui,font) \
  463.     -background $config(gui,color_bg) -foreground $config(gui,color_fg) \
  464.     -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg) \
  465.     -width 70 \
  466.     -height 30 
  467.  
  468.   label $w.bot.text -text "Click on a file name to show it in the list panel."
  469.   button $w.bot.ok -text OK -command "destroy $w"
  470.  
  471.   $w.top.list delete 0 end
  472.   eval $w.top.list insert end $result
  473.  
  474.   pack $w.top -side top -expand 1 -fill both
  475.   pack $w.top.scrollvert -side right -fill y
  476.   pack $w.top.scrollhoriz -side bottom -fill x
  477.   pack $w.top.list -side top -expand 1 -fill both
  478.   pack $w.bot -side bottom -expand 1 -fill x
  479.   pack $w.bot.text -side top -pady 4
  480.   pack $w.bot.ok -side top
  481.  
  482.   wm withdraw $w
  483.   update idletasks
  484.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  485.           - [winfo vrootx [winfo parent $w]]]
  486.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  487.           - [winfo vrooty [winfo parent $w]]]
  488.   wm geom $w +$x+$y
  489.   wm deiconify $w
  490.  
  491.   bind $w.top.list <1> "
  492.     GotoFind \[lindex \{$result\} \[$w.top.list nearest %y\]\] $inst $glob($inst,pwd);break
  493.   "
  494.   bind $w.top.list <B1-Motion> "break"
  495. }
  496.  
  497. proc GotoFind { file inst dir } {
  498.   global glob
  499.   NewPwd $inst $dir/[file dirname $file]
  500.   UpdateWindow $inst
  501.   set j 0
  502.   foreach i $glob($inst,filelist) {
  503.     set name [lindex $i 1]
  504.     if {$name == [file tail $file]} {
  505.       $glob(win,$inst).frame_listb.listbox1 selection clear 0 end
  506.       $glob(win,$inst).frame_listb.listbox1 selection set $j
  507.       $glob(win,$inst).frame_listb.listbox1 see $j
  508.       return
  509.     }
  510.     incr j
  511.   }
  512.   PopError "File $dir/$file can not be found"
  513. }
  514.  
  515. proc Clone {} {
  516.   global glob argv argv0
  517.   Try { cd $glob(start_path); exec [lindex $argv 0] $argv0 [lindex $argv 0] $glob(left,pwd) $glob(right,pwd) & } "" 1 
  518. }
  519.  
  520. proc ToggleCmdWin { inst } {
  521.   global glob config
  522.   if {$glob($inst,shell,packed)} {
  523.     pack forget $glob(win,bottom).fcmdwin$inst
  524.     if {!$glob([Opposite $inst],shell,packed)} {
  525.       pack forget $glob(win,bottom)
  526.     }
  527.     set glob($inst,shell,packed) 0
  528.     set glob($inst,shell,history,flipping) 0
  529.   } else {
  530.     if {!$glob([Opposite $inst],shell,packed)} {
  531.       pack $glob(win,bottom) -side bottom -fill x
  532.     }
  533.     $glob(win,bottom).fcmdwin$inst.text configure -height $config(shell,height,$inst)
  534.     set glob($inst,shell,maxed) 0
  535.     pack $glob(win,bottom).fcmdwin$inst -side bottom -fill x
  536.     set glob($inst,shell,packed) 1
  537.   }
  538. }
  539.  
  540. proc MaxWin { w inst } {
  541.   global glob config
  542.   if {$glob($inst,shell,maxed)} {
  543.     $glob(win,bottom).fcmdwin$inst.text configure -height $config(shell,height,$inst)
  544.     set glob($inst,shell,maxed) 0
  545.   } else {
  546.     $glob(win,bottom).fcmdwin$inst.text configure -height 2000
  547.     set glob($inst,shell,maxed) 1
  548.   }
  549. }
  550.  
  551. proc BuildCmdWindow { inst } {
  552.   global glob config
  553.  
  554.   frame $glob(win,bottom).fcmdwin$inst
  555.   set w $glob(win,bottom).fcmdwin$inst
  556.  
  557.   text $w.text -relief sunken -bd 2 -yscrollcommand "$w.fr.scroll set" -height $config(shell,height,$inst) -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  558.   lappend glob(gui,color_xx,winlist) $w.text
  559.   frame $w.fr -bd 0
  560.   scrollbar $w.fr.scroll -command "$w.text yview" 
  561.   frame $w.bot -bd 0
  562.   entry $w.bot.entry -relief ridge -font $config(gui,font) -background $config(gui,color_bg) \
  563.       -foreground $config(gui,color_fg) -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg) -highlightthickness 1 
  564.   lappend glob(gui,color_xx,winlist) $w.bot.entry
  565.   $w.text tag configure command -background $config(gui,color_cmd)
  566.   lappend glob(gui,color_cmd,winlist) $w.text
  567.   $w.text tag configure complete -background $config(gui,color_select_bg) -foreground $config(gui,color_select_fg)
  568.   label $w.bot.label -textvariable glob($inst,pwd) -font $config(gui,font) -relief ridge -padx 5
  569.   button $w.bot.max -bitmap @$glob(lib_fr)/bitmaps/max.bit \
  570.     -command "MaxWin $w $inst" -bd 1
  571.   button $w.bot.smaller -bitmap @$glob(lib_fr)/bitmaps/smaller.bit \
  572.     -command "
  573.                incr config(shell,height,$inst) -2
  574.                if \"\$config(shell,height,$inst)<1\" \"
  575.                  set config(shell,height,$inst) 1
  576.                \"
  577.                $w.text configure -height \$config(shell,height,$inst)
  578.              " -bd 1
  579.   button $w.bot.larger -bitmap @$glob(lib_fr)/bitmaps/larger.bit \
  580.     -command "incr config(shell,height,$inst) 2; $w.text configure -height \$config(shell,height,$inst)" -bd 1
  581.   label  $w.bot.running -text R
  582.   pack $w.fr.scroll -side bottom -fill y -expand 1
  583.   pack $w.fr -side $inst -fill y
  584.   pack $w.bot.label -side left 
  585.   pack $w.bot.max -side right -fill y
  586.   pack $w.bot.larger -side right -fill y
  587.   pack $w.bot.smaller -side right -fill y
  588.   pack $w.bot.running -side right -fill y
  589.   pack $w.bot.entry -side bottom -fill x
  590.   pack $w.bot -side bottom -fill x
  591.   pack $w.text -expand 1 -fill both
  592.   menu $w.text.p
  593.   $w.text.p add command -label Search... -command "SearchView $w.text 0"
  594.   $w.text.p add command -label {Search Again} -command "SearchView $w.text 1"
  595.   $w.text.p add command -label {Save As...} -command "SaveToFile $w.text {} 1"
  596.   #bind $w.bot.max <FocusIn> "focus $w.bot.entry"
  597.   bind $w.bot.entry <Return> "ExecCmdInWin $inst $w; catch \"focus $w.bot.entry\" out; break"
  598.   bind $w.bot.entry <KP_Enter> "ExecCmdInWin $inst $w;catch \"focus $w.bot.entry\" out; break"
  599.   bind $w.bot.entry <Tab> "Complete $inst $w;break"
  600.   bind $w.bot.entry <Control-d> "CompleteShow $inst $w"
  601.   bind $w.bot.entry <Control-p> "FlipShellHistory $w.bot.entry $inst searchback"
  602.   bind $w.bot.entry <Control-c> "$w.bot.entry delete 0 end"
  603.   bind $w.bot.entry <Up> "FlipShellHistory $w.bot.entry $inst up"
  604.   bind $w.bot.entry <Down> "FlipShellHistory $w.bot.entry $inst down"
  605.   bind $w.bot.entry <Enter> "focus $w.bot.entry"
  606.   bind $w.bot.entry <Leave> "focus ."
  607.   bind $w.text <3> "tk_popup $w.text.p %X %Y"
  608.   bind $w.text <Enter> "focus $w.bot.entry"
  609.   bind $w.text <Leave> "focus ."
  610.   bind $w.text <FocusIn> "focus $w.bot.entry"
  611. }
  612.  
  613. proc CompleteShow { inst w } {
  614.   set cmd [$w.bot.entry get]
  615.   #puts "completeshow $cmd"
  616.   set insidx [expr [$w.bot.entry index insert] - 1]
  617.   set wstart [string wordstart [FixCompleteString $cmd] $insidx]
  618.   set wend [string wordend [FixCompleteString $cmd] $insidx]
  619.   set word [string trim [string range $cmd $wstart $insidx]]
  620.   #puts "word:$word"
  621.   if {$word == ""} return
  622.   if {$wstart == 0} { set is_verb 1 } else { set is_verb 0 }
  623.   set l [FilenameComplete $word $is_verb $inst]
  624.   $w.text insert end "\n$l"
  625.   $w.text tag add complete "insert - 1 lines + 1 chars" "insert"
  626.   $w.text see insert
  627. }
  628.  
  629. proc FixCompleteString { cmd } {
  630.   set l ""
  631.   set len [string length $cmd]
  632.   for {set i 0} {$i < $len} {incr i} {
  633.     set c [string index $cmd $i]
  634.     if {$c != " "} {
  635.       set l "${l}x"
  636.     } else {
  637.       set l "${l}$c"
  638.     }
  639.   }
  640.   return $l
  641. }
  642.  
  643. proc Complete { inst w } {
  644.   global glob
  645. #  set glob($inst,shell,complete,flipping) 0
  646.  
  647.   if {!$glob($inst,shell,complete,flipping)} {
  648.     set glob($inst,shell,complete,index) 0
  649.     set cmd [$w.bot.entry get]
  650.     set insidx [expr [$w.bot.entry index insert] - 1]
  651.     set wstart [string wordstart [FixCompleteString $cmd] $insidx]
  652.     set wend [string wordend [FixCompleteString $cmd] $insidx]
  653.     set word [string trim [string range $cmd $wstart $insidx]]
  654.     #puts "word:$word"
  655.     if {$word == ""} return
  656.     if {$wstart == 0} { set is_verb 1 } else { set is_verb 0 }
  657.     set glob($inst,shell,complete,list) [FilenameComplete $word $is_verb $inst]
  658.     set repl [lindex $glob($inst,shell,complete,list) $glob($inst,shell,complete,index)]
  659.     incr glob($inst,shell,complete,index)
  660.     if {$repl == ""} return
  661.     #puts "repl:$repl"
  662.     set head [string range $cmd 0 [expr $wstart-1]]
  663.     set tail [string range $cmd $wend end]
  664.     set newcmd "$head$repl$tail"
  665.     $w.bot.entry delete 0 end
  666.     $w.bot.entry insert end $newcmd
  667. #    $w.bot.entry icursor [expr $insidx + 1]
  668.     $w.bot.entry icursor [string wordend [FixCompleteString $newcmd] $insidx]
  669.     #puts "$cmd,$word,$wstart,$insidx,$repl,$head,$tail"
  670.     set glob($inst,shell,complete,flipping) 1
  671.   } else {
  672.     if {[$w.bot.entry get] != $glob($inst,shell,complete,newcmd) && $glob($inst,shell,complete,newidx) != [$w.bot.entry index insert]} {
  673.       set glob($inst,shell,complete,flipping) 0
  674.       Complete $inst $w
  675.       return
  676.     }
  677.     set cmd $glob($inst,shell,complete,cmd)
  678.     $w.bot.entry delete 0 end
  679.     $w.bot.entry insert end $cmd
  680.     set word $glob($inst,shell,complete,word) 
  681.     set wstart $glob($inst,shell,complete,wstart)
  682.     set wend $glob($inst,shell,complete,wend)
  683.     set insidx $glob($inst,shell,complete,insidx)
  684.     set repl [lindex $glob($inst,shell,complete,list) $glob($inst,shell,complete,index)]
  685.     incr glob($inst,shell,complete,index)
  686.     if {$repl == ""} { 
  687.       $w.bot.entry icursor [string wordend [FixCompleteString $cmd] $insidx]
  688.       set glob($inst,shell,complete,flipping) 0
  689.       return
  690.     }
  691.     #puts "repl:$repl"
  692.     set head [string range $cmd 0 [expr $wstart-1]]
  693.     set tail [string range $cmd $wend end]
  694.     set newcmd "$head$repl$tail"
  695.     $w.bot.entry delete 0 end
  696.     $w.bot.entry insert end $newcmd
  697. #    $w.bot.entry icursor [expr $insidx + 1]
  698.     $w.bot.entry icursor [string wordend [FixCompleteString $newcmd] $insidx]
  699.     #puts "$cmd,$word,$wstart,$insidx,$repl,$head,$tail"
  700.   }
  701.   set glob($inst,shell,complete,cmd) $cmd
  702.   set glob($inst,shell,complete,word) $word
  703.   set glob($inst,shell,complete,wstart) $wstart
  704.   set glob($inst,shell,complete,wend) $wend
  705.   set glob($inst,shell,complete,insidx) $insidx
  706.   set glob($inst,shell,complete,newidx) [$w.bot.entry index insert]
  707.   set glob($inst,shell,complete,newcmd) $newcmd
  708. }
  709.  
  710. proc FilenameComplete { word is_verb inst } {
  711.   global glob config env
  712.   set candidates {}
  713.   if {$is_verb && [string index $word 0] != "/"} {
  714.     foreach k [split $env(PATH) :] {
  715.       set c [glob -nocomplain $k/${word}*]
  716.       if {$c != ""} {
  717.         set candidates [concat $candidates $c]
  718.       }
  719.     }
  720.   } else {
  721.     set r [catch {cd $glob($inst,pwd)} out]
  722.     if {$r} {
  723.       PopError "$out"
  724.       return ""
  725.     }
  726.     set r [catch {glob -nocomplain ${word}*} c]
  727.     if {!$r && $c != ""} {
  728.       set candidates [concat $candidates $c]
  729.     }
  730.   }
  731.   return $candidates
  732. }
  733.  
  734.  
  735.  
  736. proc ExecCmdInWin { inst w } {
  737.   global glob config env
  738. #  focus $w.bot.entry
  739.   set glob($inst,shell,history,flipping) 0
  740.   set glob($inst,shell,complete,flipping) 0
  741.   set cmd [string trim [$w.bot.entry get]]
  742.   if {$cmd == ""} return
  743.   $w.bot.entry delete 0 end
  744.   $w.text mark set insert end
  745.   $w.text see insert
  746.   set verb [lindex $cmd 0]
  747.   if {[IsFTP $glob($inst,pwd)]} {
  748.     PopError "Sorry, can't execute commands in ftp directories"
  749.     return
  750.   }
  751.  
  752.   set r [catch {cd $glob($inst,pwd)} out]
  753.   if {$r} {
  754.     PopError "$out"
  755.     return
  756.   }
  757.  
  758.   # expand aliases
  759.   set alias ""
  760.   foreach k $config(shell,aliases) {
  761.     if {$verb == [lindex $k 0]} {
  762.       set alias [lindex $k 1]
  763.       break
  764.     }
  765.   }
  766.   if {$alias != ""} {
  767.     set cmd [concat $alias [lrange $cmd 1 end]]
  768.     set verb [lindex $cmd 0]
  769.   }
  770.  
  771.   $w.text insert end "\n$glob($inst,pwd) > $cmd\n"
  772.   $w.text tag add command "insert - 1 lines" "insert - 1 chars"
  773.   $w.text see "insert - 1 chars"
  774.   update
  775.  
  776.   if {[string match *& $cmd]} {
  777.     catch {eval exec $cmd} out
  778.     $w.text insert end $out
  779.   } else {
  780.   switch -glob $verb { 
  781.     %* {
  782.         # Tcl commands
  783.         set r [catch { eval [string range $cmd 1 end] } out]
  784.         if {$r} {
  785.           $w.text insert end "tcl error: $out"
  786.         } else {
  787.           $w.text insert end "$out"
  788.         }
  789.       }
  790.     cd {
  791.         # this code is a little extra fluffy, because we want to avoid the error handling in NewPwd/UpdateWindow
  792.         # which we could have used also, but it doesn't look as neat. (It pops up an error popup...)
  793.         set newpwd [lindex $cmd 1]
  794.         if {$newpwd == ""} {set newpwd $env(HOME)}
  795.         set r [catch {cd $newpwd} out]
  796.         if {!$r} {
  797.           set r [catch {cd $glob($inst,pwd)} out]
  798.           NewPwd $inst $newpwd
  799.           UpdateWindow $inst
  800.           $w.text insert end "ok"
  801.         } else {
  802.           $w.text insert end "cd error: $out"
  803.         }
  804.       }
  805.     view {
  806.         ViewAny [lrange $cmd 1 end]
  807.       }
  808.     history {
  809.         $w.text insert end "$glob($inst,shell,history)"
  810.       }
  811.     default {
  812.         incr glob($inst,shellcount)
  813.         if {$glob($inst,shellcount) == 1} {
  814.           set glob($inst,runlabel,bg) [$w.bot.running cget -bg]
  815.           $w.bot.running configure -bg red
  816.           update idletasks
  817.         }
  818.         set r [catch {open "|$config(cmd,sh) -c \{$cmd 2>&1\}" r} fid]
  819.         if {$r} {
  820.           $w.text insert end "Exec error: $fid\n"
  821.         } else {
  822.           fconfigure $fid -buffering none
  823.           fconfigure $fid -blocking 0
  824.           fconfigure $fid -translation binary
  825.           # give command time to do something before we read it's output
  826.           after [ReadDelay 0]
  827.           set i 0
  828.           while {1} {
  829.             incr i
  830.             set out [read $fid]
  831.             if {$out != ""} {
  832.               $w.text insert end "$out"
  833.             }
  834.             if {[eof $fid]} {
  835.               if {[$w.text get "end - 1 chars"] == "\n"} {
  836.                 $w.text delete "end - 1 chars"
  837.               }
  838.               break
  839.             }
  840.             if {$out != ""} {
  841.               $w.text see insert
  842.             }
  843.             after [ReadDelay $i]
  844.             update
  845.           }
  846.           catch {close $fid}
  847.         }
  848.         incr glob($inst,shellcount) -1
  849.         if {$glob($inst,shellcount) == 0} {
  850.           $w.bot.running configure -bg $glob($inst,runlabel,bg)
  851.         }
  852.       }
  853.     }
  854.   }
  855.   $w.text see insert
  856.   set size_text [file rootname [$w.text index end]]
  857.   if {$size_text > [expr ($config(shell,buffer) * 4) / 3]} {
  858.     $w.text delete 0.1 [expr ${size_text} - $config(shell,buffer)].1
  859.   }
  860.   lappend glob($inst,shell,history) $cmd
  861.   set len [llength $glob($inst,shell,history)]
  862.   if {$len > 250} {
  863.     set glob($inst,shell,history) [lrange [expr $len - 200] end]
  864.   }
  865.   LogStatusOnly "Shell: \"$cmd\" - done"
  866. }
  867.  
  868. proc ReadDelay { i } {
  869.   #puts -nonewline "@"
  870.   flush stdout
  871.   set len [expr 200 + ($i * 50)]
  872.   if {$len > 1000} {set len 1000}
  873.   return $len
  874. }
  875.  
  876.  
  877. proc FlipShellHistory { w inst direction } {
  878.   global glob
  879.   switch $direction {
  880.     up {
  881.         if {!$glob($inst,shell,history,flipping)} {
  882.           set glob($inst,shell,history,flipping,index) [expr [llength $glob($inst,shell,history)] - 1]
  883.           set glob($inst,shell,history,flipping) 1
  884.         } else {
  885.           incr glob($inst,shell,history,flipping,index) -1
  886.           if {$glob($inst,shell,history,flipping,index) < -1} {set glob($inst,shell,history,flipping,index) -1}
  887.         }
  888.       }
  889.     down {
  890.         if {!$glob($inst,shell,history,flipping)} {
  891.           set glob($inst,shell,history,flipping,index) 0
  892.           set glob($inst,shell,history,flipping) 1
  893.         } else {
  894.           incr glob($inst,shell,history,flipping,index) 1
  895.           set len [llength $glob($inst,shell,history)]
  896.           if {$glob($inst,shell,history,flipping,index) > $len} {set glob($inst,shell,history,flipping,index) [expr $len]}
  897.         }
  898.       }
  899.     searchback {
  900.         if {!$glob($inst,shell,history,flipping)} {
  901.           set start [expr [llength $glob($inst,shell,history)] - 1]
  902.           set cmd [string trim [$w get]]
  903.           set glob($inst,shell,history,flipping,cmd) $cmd
  904.         } else {
  905.           set start [expr $glob($inst,shell,history,flipping,index) -1]
  906.           if {$start < -1} {set start -1}
  907.           set cmd $glob($inst,shell,history,flipping,cmd)
  908.         }
  909.         #puts "$cmd $start"
  910.         for {set i $start} {$i >= 0} {incr i -1} {
  911.           if {$cmd == [string range [lindex $glob($inst,shell,history) $i] 0 [expr [string length $cmd] -1]]} {
  912.             set glob($inst,shell,history,flipping,index) $i
  913.             set glob($inst,shell,history,flipping) 1
  914.             break
  915.           }
  916.         }
  917.         if {!$glob($inst,shell,history,flipping)} return
  918.       }
  919.   }
  920.   $w delete 0 end
  921.   $w insert end [lindex $glob($inst,shell,history) $glob($inst,shell,history,flipping,index)]
  922. }
  923.  
  924.  
  925. proc CheckGrab { r reason } {
  926.   if {$r} {
  927.     LogStatusOnly "$reason (non fatal)"
  928.   }
  929. }
  930.  
  931. # This routine is for commands that don't want the autoupdater to run
  932. # and invoke "update" during operation
  933. proc DoProtCmd { cmd } {
  934.   global glob 
  935.   set glob(focus_before_doprotcmd) [focus]
  936.   focus $glob(win,top).status
  937.   frgrab $glob(win,top).menu_frame.fasync_cmds
  938.   set oldcur [. cget -cursor]
  939.   set oldena $glob(enableautoupdate)
  940.   . config -cursor circle
  941.   #wm iconname . "FileRunner v$glob(version) - busy"
  942.   update idletasks
  943.   set glob(enableautoupdate) 0
  944.   set glob(abortcmd) 0
  945.   uplevel $cmd
  946.   set glob(enableautoupdate) $oldena
  947.   . config -cursor $oldcur
  948.   #wm iconname . "FileRunner v$glob(version)"
  949.   catch {grab release [grab current]}
  950.   #catch {focus $glob(focus_before_doprotcmd)}
  951.   focus $glob(win,top).status 
  952. }
  953.  
  954. # This routine is for commands that don't want the autoupdater to run
  955. # but do not invoke "update" during operation
  956. proc DoProtCmd_NoGrab { cmd } {
  957.   global glob 
  958.   #grab set $glob(win,top).menu_frame.fasync_cmds
  959.   #focus $glob(win,top).status
  960.   set oldcur [. cget -cursor]
  961.   set oldena $glob(enableautoupdate)
  962.   . config -cursor circle
  963.   #wm iconname . "FileRunner v$glob(version) - busy"
  964.   update idletasks
  965.   set glob(enableautoupdate) 0
  966.   set glob(abortcmd) 0
  967.   uplevel $cmd
  968.   set glob(enableautoupdate) $oldena
  969.   . config -cursor $oldcur
  970.   #wm iconname . "FileRunner v$glob(version)"
  971.   #grab release $glob(win,top).menu_frame.fasync_cmds
  972. }
  973.  
  974. proc SetStartDir { inst } {
  975.   global glob config
  976.   set config(startpwd,$inst) $glob($inst,pwd)
  977.   LogStatusOnly "config(startpwd,$inst) set. Do \"Configuration->Save configuration\" if you want to store it to the .fr file"
  978.   #SaveConfig
  979. }
  980.  
  981. proc SetWinPos {} {
  982.   global glob config
  983.   set config(geometry,main) [wm geometry .]
  984.   LogStatusOnly "config(geometry,main) set. Do \"Configuration->Save configuration\" if you want to store it to the .fr file"
  985. }
  986.  
  987.  
  988. proc ShowCmds { dir } {
  989.   global glob
  990.   set height1 [winfo height $glob(win,middle)]
  991.   set height2 [winfo height $glob(win,middle).1]
  992.   set step [expr (3 * $height1) / (4 * $height2)]
  993.   if { $step < 1 } { set step 1 }
  994.   set oldcur $glob(cmds,cur)
  995.   if { $dir == "down" } {
  996.     incr glob(cmds,cur) $step
  997.   }
  998.   if { $dir == "up" } {
  999.     incr glob(cmds,cur) -$step
  1000.   }
  1001.  
  1002.   set tmp [expr [llength $glob(cmds,list)] - ($height1-$height2)/$height2 ]
  1003.   if { $glob(cmds,cur) > $tmp } {
  1004.     set glob(cmds,cur) $tmp
  1005.   }
  1006.  
  1007.   set tmp [expr [llength $glob(cmds,list)] -1 ]
  1008.   if { $glob(cmds,cur) > $tmp } {
  1009.     set glob(cmds,cur) $tmp
  1010.   }
  1011.   if { $glob(cmds,cur) < 0 } {
  1012.     set glob(cmds,cur) 0
  1013.   }
  1014.  
  1015.   if {$oldcur < $glob(cmds,cur)} {
  1016.     for {set i $oldcur} {$i < $glob(cmds,cur)} {incr i} {
  1017.       pack forget $glob(win,middle).$i
  1018.     }
  1019.     return
  1020.   }
  1021.   if {$oldcur > $glob(cmds,cur)} {
  1022.     for {set i [expr $oldcur-1]} {$i >= $glob(cmds,cur)} {incr i -1} {
  1023.       pack $glob(win,middle).$i -before $glob(win,middle).[expr $i+1] -fill x
  1024.     }
  1025.     return
  1026.   }
  1027. }
  1028.  
  1029. proc About {} {
  1030.   global glob
  1031.   set button [tk_dialog_about .apop "About FileRunner" "FileRunner version $glob(version)
  1032.  
  1033. Copyright (C) 1996-1998 Henrik Harmsen
  1034.  
  1035. FileRunner is Open Source software distributed under the 
  1036. GNU General Public License. FileRunner comes with ABSOLUTELY 
  1037. NO WARRANTY. See menu Help/Copying for further details.
  1038.  
  1039. If you like FileRunner, please send me a cool postcard I can 
  1040. put on my fridge! (Or a fridge magnet, I'm running out :-) 
  1041. See the online User's Guide for my home address.
  1042.  
  1043. " "" 0 "OK"]
  1044. }
  1045.  
  1046. proc ForceUpdate {} {
  1047.   global glob
  1048.   set glob(forceupdate) 1
  1049.   UpdateWindow both
  1050.   set glob(forceupdate) 0
  1051. }
  1052.  
  1053. proc BuildFileListPanel { inst } {
  1054.  
  1055.   global glob config
  1056.  
  1057.   frame $glob(win,$inst) -borderwidth 1 -relief raised
  1058.   frame $glob(win,$inst).dirmenu_frame -borderwidth 1 -relief raised
  1059.   frame $glob(win,$inst).top -bd 1 -relief raised
  1060.   frame $glob(win,$inst).top.t -bd 0 -relief raised
  1061.   frame $glob(win,$inst).frame_listb
  1062.  
  1063.   menubutton $glob(win,$inst).dirmenu_frame.dir_but -menu $glob(win,$inst).dirmenu_frame.dir_but.m -bitmap @$glob(lib_fr)/bitmaps/tree.bit
  1064.  
  1065.   menu $glob(win,$inst).dirmenu_frame.dir_but.m -tearoff false -postcommand  "eval CdMenuCreate \
  1066.       ${inst} \[Esc \$glob($inst,pwd) \] $glob(win,$inst).dirmenu_frame.dir_but.m 1"
  1067.  
  1068.   menubutton $glob(win,$inst).dirmenu_frame.hotlist_but -menu $glob(win,$inst).dirmenu_frame.hotlist_but.m -text Hotlist
  1069.  
  1070.   menu $glob(win,$inst).dirmenu_frame.hotlist_but.m -tearoff false -postcommand " 
  1071.       CreateHotListMenu $inst
  1072.     "
  1073.  
  1074.   menubutton $glob(win,$inst).dirmenu_frame.history_but -menu $glob(win,$inst).dirmenu_frame.history_but.m -text History
  1075.  
  1076.   menu $glob(win,$inst).dirmenu_frame.history_but.m -tearoff false -postcommand "CreateHistoryMenu $inst"
  1077.  
  1078.  
  1079.   menubutton $glob(win,$inst).dirmenu_frame.etc_but -menu $glob(win,$inst).dirmenu_frame.etc_but.m -text Etc
  1080.  
  1081.   menu $glob(win,$inst).dirmenu_frame.etc_but.m -tearoff false 
  1082.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {Find File...} -command "DoProtCmd \"CmdFind $inst\""
  1083.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {Create Empty File...} -command "DoProtCmd \"CmdCreateEmptyFile $inst\""
  1084.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {Recurse Command...} -command "DoProtCmd \"CmdRecurseCommand $inst\""
  1085.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {Add To FTP Batch List} -command "AddToBatchList $inst"
  1086.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {View FTP Batch List} -command "ViewBatchList"
  1087.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {Clear FTP Batch List} \
  1088.       -command "set glob(batchlist) {}"
  1089.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {FTP Batch Receive} \
  1090.       -command "DoProtCmd \"BatchReceiveFTP $inst\""
  1091.   $glob(win,$inst).dirmenu_frame.etc_but.m add command -label {HTTP Download} \
  1092.       -command "DoProtCmd \"CmdGetHttp $inst\""
  1093.  
  1094.  
  1095.   # Create buttons
  1096.   button $glob(win,$inst).dirmenu_frame.button_parentdir -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/up.bit -command "DoProtCmd \" 
  1097.     NewPwd $inst \\\$glob(${inst},pwd)/..
  1098.     UpdateWindow $inst\"
  1099.   "
  1100.  
  1101.   button $glob(win,$inst).top.button_back -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/left.bit -command "DoProtCmd \" 
  1102.     Back ${inst}\"
  1103.   " -width 22
  1104.  
  1105.   button $glob(win,$inst).top.button_xterm -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/xterm.bit -command " 
  1106.     Try \" StartTerm \\\$glob(${inst},pwd) $inst \" \"\" 1
  1107.   "
  1108.  
  1109.   button $glob(win,$inst).top.button_frterm -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/frterm.bit -command " 
  1110.     ToggleCmdWin $inst
  1111.   "
  1112.  
  1113.   button $glob(win,$inst).top.button_update -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/update.bit \
  1114.       -command "DoProtCmd \"set glob(forceupdate) 1; FTP_InvalidateCache; UpdateWindow $inst; set glob(forceupdate) 0\""
  1115.  
  1116.  
  1117.   entry $glob(win,$inst).entry_dir -relief {ridge} -font $config(gui,font) \
  1118.       -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg) -background $config(gui,color_bg) \
  1119.       -foreground $config(gui,color_fg) -highlightthickness 1 
  1120.   lappend glob(gui,color_xx,winlist) $glob(win,$inst).entry_dir
  1121.  
  1122.  
  1123.   # Create listbox
  1124.   frame $glob(win,$inst).frame_listb.right -bd 0
  1125.   scrollbar $glob(win,$inst).frame_listb.scroll_horiz -command "$glob(win,$inst).frame_listb.listbox1 xview" -orient {horizontal} \
  1126.     -relief {sunken}
  1127.   scrollbar $glob(win,$inst).frame_listb.right.scroll_vert -command "$glob(win,$inst).frame_listb.listbox1 yview" \
  1128.       -relief {sunken}
  1129.   listbox $glob(win,$inst).frame_listb.listbox1 \
  1130.     -relief {ridge} \
  1131.     -xscrollcommand "$glob(win,$inst).frame_listb.scroll_horiz set" \
  1132.     -yscrollcommand "$glob(win,$inst).frame_listb.right.scroll_vert set" \
  1133.     -selectmode extended \
  1134.     -font $config(gui,font) \
  1135.     -background $config(gui,color_bg) -foreground $config(gui,color_fg) \
  1136.     -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  1137.   lappend glob(gui,color_xx,winlist) $glob(win,$inst).frame_listb.listbox1
  1138.   lappend glob(gui,tablist) $glob(win,$inst).frame_listb.listbox1
  1139.   bind $glob(win,$inst).frame_listb.listbox1 <Tab> {TabBind $glob(gui,tablist);break}
  1140.   bind $glob(win,$inst).frame_listb.listbox1 $config(mwheel,neg) \
  1141.       "$glob(win,$inst).frame_listb.listbox1 yview scroll -$config(mwheel,delta) units"
  1142.   bind $glob(win,$inst).frame_listb.listbox1 $config(mwheel,pos) \
  1143.       "$glob(win,$inst).frame_listb.listbox1 yview scroll $config(mwheel,delta) units"
  1144.  
  1145.   selection handle $glob(win,$inst).frame_listb.listbox1 GetFileListBoxSTRING_Selection STRING
  1146.  
  1147.   label $glob(win,$inst).top.t.stat -text "" -justify center
  1148.  
  1149.   button $glob(win,$inst).frame_listb.right.select_toggle -bitmap @$glob(lib_fr)/bitmaps/toggle.bit -command "ToggleSelect $inst" \
  1150.       -width 1 -height 12 -bd 1
  1151.  
  1152.   pack $glob(win,$inst).dirmenu_frame.dir_but \
  1153.     $glob(win,$inst).dirmenu_frame.hotlist_but \
  1154.     $glob(win,$inst).dirmenu_frame.history_but \
  1155.     $glob(win,$inst).dirmenu_frame.etc_but -side left -fill both
  1156.   pack $glob(win,$inst).dirmenu_frame.button_parentdir -side left -expand 1 -fill both
  1157.  
  1158.   pack $glob(win,$inst).frame_listb.right -side right -fill y
  1159.   pack $glob(win,$inst).frame_listb.right.scroll_vert -side top -fill y -expand 1
  1160.   pack $glob(win,$inst).frame_listb.right.select_toggle -side bottom -fill both
  1161.   pack $glob(win,$inst).frame_listb.listbox1 -side top -expand 1 -fill both
  1162.   pack $glob(win,$inst).frame_listb.scroll_horiz -side bottom -fill x
  1163.  
  1164.   pack $glob(win,$inst).top -side top -fill x
  1165.   pack $glob(win,$inst).top.button_xterm -side right -fill both
  1166.   pack $glob(win,$inst).top.button_frterm -side right -fill both
  1167.   pack $glob(win,$inst).top.button_back -side left -fill both
  1168.   pack $glob(win,$inst).top.button_update -side left -fill both
  1169.   pack $glob(win,$inst).top.t -side left -fill both -expand 1
  1170.   pack propagate $glob(win,$inst).top.t 0
  1171.   pack $glob(win,$inst).top.t.stat -side left -fill both -expand 1
  1172.   pack $glob(win,$inst).dirmenu_frame -side top -fill x
  1173.   pack $glob(win,$inst).entry_dir -side top -fill x
  1174.   pack $glob(win,$inst).frame_listb -side top -fill both -expand 1
  1175. }
  1176.  
  1177. proc GetFileListBoxSTRING_Selection {offset maxBytes } {
  1178.   global glob
  1179.   set l {}
  1180.   foreach inst {left right} {
  1181.     foreach sel [$glob(win,$inst).frame_listb.listbox1 curselection] {
  1182.       set l "$l $glob($inst,pwd)/[lindex [lindex $glob($inst,filelist) $sel] 1]"
  1183.     }
  1184.   }
  1185.   return [string range $l 1 $maxBytes]
  1186. }
  1187.  
  1188.  
  1189.  
  1190. proc GetDirList { directory } {
  1191.   global config glob
  1192.  
  1193.   set dl {}
  1194.  
  1195.   if { [IsFTP $directory] } {
  1196.     set mode ftp
  1197.     regexp {ftp://([^/]*)(.*)} $directory match ftpI directory
  1198.   } else {
  1199.     set mode normal
  1200.   }
  1201.  
  1202.   if { $mode == "ftp" } {
  1203.     set dummy {{0 {Can't get file list, try again?} n 0 0 0 0 0}}
  1204.     set r [catch {FTP_CD $ftpI $directory} outp]
  1205.     if {$r != 0} {
  1206.       PopError $outp
  1207.       return $dummy
  1208.     }
  1209.     set r [catch {FTP_List $ftpI $config(fileshow,all)} dirlist]
  1210.     if {$r != 0} {
  1211.       PopError $dirlist
  1212.       return $dummy
  1213.     }
  1214.  
  1215. # Example of output (now placed in outp)
  1216. #total 3333 (optional)
  1217. #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 .
  1218. #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 ..
  1219. #lrwxrwxrwx   1 root     root           11 Mar 16 14:28 apa -> welcome.msg
  1220. #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 bin
  1221. #drwxrwxr-x   2 root     wheel        1024 Aug 30  1993 etc
  1222. #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 incoming
  1223. #drwxrwxr-x   2 root     wheel        1024 Nov 17  1993 lib
  1224. #drwxrwxr-x   3 root     wheel        1024 Mar 10 16:08 pub
  1225. #drwxrwxr-x   3 root     wheel        1024 Aug 30  1993 usr
  1226. #-rw-r--r--   1 root     root          312 Aug  1  1994 welcome.msg
  1227.  
  1228. #wuarchive.wustl.edu:
  1229. #-rw-r--r--   1 0                      605 Sep 27 14:45 README.NFS
  1230. #-rw-r--r--   1 0                      474 Sep 27 14:45 README.SIMTEL
  1231. #lrwxrwxrwx   1 0                        9 Sep 26 12:56 bin -> ./usr/bin
  1232.  
  1233. #ftp://reactor.actlab.com (Yucky WinNT output)
  1234. #12-02-97  02:17AM       <DIR>          !Incoming
  1235. #06-03-97  09:38PM       <DIR>          !support
  1236. #06-03-97  09:38PM       <DIR>          7thlevel
  1237. #06-03-97  09:38PM       <DIR>          access
  1238. #06-03-97  09:38PM       <DIR>          accolade
  1239. #06-03-97  09:39PM       <DIR>          Activision
  1240. #09-11-96  07:10PM                 3592 ACTlogo.gif
  1241. #06-03-97  09:40PM       <DIR>          Apogee
  1242. #06-03-97  09:40PM       <DIR>          avalon
  1243. #06-03-97  09:40PM       <DIR>          beam
  1244.  
  1245.     set dosorttest 1
  1246.  
  1247.     switch -exact $config(fileshow,sort) {
  1248.       nameonly {
  1249.         set sortval_n  1
  1250.         set sortval_d  1
  1251.         set sortval_l  1
  1252.         set sortval_ld 1
  1253.         set dosorttest 0
  1254.       } 
  1255.       dirsfirst {
  1256.         set sortval_n  2
  1257.         set sortval_d  1
  1258.         set sortval_l  2
  1259.         set sortval_ld 1
  1260.         set dosorttest 0
  1261.       }
  1262.       dirslast {
  1263.         set sortval_n  1
  1264.         set sortval_d  2
  1265.         set sortval_l  1
  1266.         set sortval_ld 2
  1267.         set dosorttest 0
  1268.       }
  1269.     }
  1270.  
  1271.  
  1272.     foreach k $dirlist {
  1273.       if { $k == "" } continue
  1274.       if { [string range $k 0 4] == "total" } continue
  1275.  
  1276.       set filetype fn
  1277.  
  1278.       # Try regular parsing
  1279.       set r [regexp {^([^ ])([^ ]+) *[0-9]+ +([^ ]+) +([^ ]+) +([0-9]+) +(............) (((.+) -> (.+))|(.+))} \
  1280.                  $k match type flags owner group size date i1 i2 i3 i4]
  1281.  
  1282.       if {!$r} {
  1283.         # Try wuarchive.wustl.edu parsing
  1284.         set r [regexp {^([^ ])([^ ]+) *[0-9]+ +([^ ]+) +([0-9]+) +(............) (((.+) -> (.+))|(.+))} \
  1285.                  $k match type flags owner       size date i1 i2 i3 i4]
  1286.         if {!$r} {
  1287.           # Try WinNT parsing
  1288.           set r [regexp {(.................)(......................)(.+)} \
  1289.               $k match date type i1]
  1290.           if {!$r} {
  1291.             PopError "Error parsing ftp LIST output: $k"
  1292.             return $dummy
  1293.           }
  1294.           set i3 {}
  1295.           set type [string trim $type]
  1296.           set flags rwxrwxrwx
  1297.           set owner 0
  1298.           set group 0
  1299.           if {$type == "<DIR>"} {
  1300.             set size 0
  1301.             set type d
  1302.           } else {
  1303.             set size $type
  1304.             set type n
  1305.           }
  1306.         }
  1307.         set group 0
  1308.       }
  1309.  
  1310.       if {"$i3" != ""} {
  1311.         set file [string trimright $i3 "\n"]
  1312.         set link [string trimright $i4 "\n"]
  1313.       } else {
  1314.         set file [string trimright $i1 "\n"]
  1315.       }
  1316.  
  1317.       if {"$file" == "." || "$file" == ".."} continue
  1318.       if {$type == "-"} { set type n}
  1319.       switch -exact $type {
  1320.         d  { set filetype fd }
  1321.         l  { if { $config(ftp,fastlink) == 1 } {
  1322.                set r [catch {FTP_IsDir $ftpI "$directory/$file"} outp]
  1323.                if { $r != 0 } { PopError "Fatal error: $outp"; CleanUp 1 }
  1324.                if {!$outp} {
  1325.                  set filetype fl
  1326.                } else {
  1327.                  set filetype fld
  1328.                }
  1329.              } else {
  1330.                set filetype fld
  1331.              }
  1332.            }
  1333.         s  -
  1334.         p  -
  1335.         n  { set filetype fn }
  1336.         default { PopError "Error parsing ftp LIST output: $k"; return $dummy }
  1337.       }
  1338.       set sec [FTPDateStringToSeconds $date]
  1339.       if {$dosorttest} {
  1340.         switch -exact $config(fileshow,sort) {
  1341.           time {
  1342.             set tmp [format "%011d" $sec]
  1343.             set sortval_n  $tmp
  1344.             set sortval_d  $tmp
  1345.             set sortval_l  $tmp
  1346.             set sortval_ld $tmp
  1347.           }
  1348.           rtime {
  1349.             set tmp [format "%011d" [expr 2147483647 - $sec]]
  1350.             set sortval_n  $tmp
  1351.             set sortval_d  $tmp
  1352.             set sortval_l  $tmp
  1353.             set sortval_ld $tmp
  1354.           }
  1355.           size {
  1356.             set tmp [format "%011d" $size]
  1357.             set sortval_n  $tmp
  1358.             set sortval_d  $tmp
  1359.             set sortval_l  $tmp
  1360.             set sortval_ld $tmp
  1361.           }
  1362.           extension {
  1363.             set tmp [file extension $file]$file
  1364.             set sortval_n  $tmp
  1365.             set sortval_d  $tmp
  1366.             set sortval_l  $tmp
  1367.             set sortval_ld $tmp
  1368.           }
  1369.         }
  1370.       }
  1371.                             
  1372.       switch -exact $filetype {
  1373.         fn  {lappend dl [list $sortval_n  $file fn  $size $sec $flags $owner $group]}
  1374.         fd  {lappend dl [list $sortval_d  $file fd  $size $sec $flags $owner $group]}
  1375.         fl  {lappend dl [list $sortval_l  $file fl  $size $sec $flags $owner $group $link]}
  1376.         fld {lappend dl [list $sortval_ld $file fld $size $sec $flags $owner $group $link]}
  1377.       }
  1378.     }
  1379.     return [lsort $dl]
  1380.   }
  1381.  
  1382.   cd $directory
  1383.   set noperm 0
  1384.   if {$config(fileshow,all)} {
  1385.     set r [catch {glob -nocomplain .* *} dirlist]
  1386.   } else {
  1387.     set r [catch {glob -nocomplain *} dirlist]
  1388.   }
  1389.   if {$r} {
  1390.     set noperm 1
  1391.     set dirlist {}
  1392.   }
  1393.  
  1394.   set dosorttest 1
  1395.  
  1396.   switch -exact $config(fileshow,sort) {
  1397.     nameonly {
  1398.       set sortval_n  1
  1399.       set sortval_d  1
  1400.       set sortval_l  1
  1401.       set sortval_ld 1
  1402.       set dosorttest 0
  1403.     } 
  1404.     dirsfirst {
  1405.       set sortval_n  2
  1406.       set sortval_d  1
  1407.       set sortval_l  2
  1408.       set sortval_ld 1
  1409.       set dosorttest 0
  1410.     }
  1411.     dirslast {
  1412.       set sortval_n  1
  1413.       set sortval_d  2
  1414.       set sortval_l  1
  1415.       set sortval_ld 2
  1416.       set dosorttest 0
  1417.     }
  1418.   }
  1419.  
  1420.   foreach k $dirlist {
  1421.     if {[catch { file lstat "$k" statinfo }]} continue
  1422.  
  1423.     set filetype n
  1424.  
  1425.     if {($statinfo(mode) & 0170000) == 040000} {
  1426.       set filetype d
  1427.     }
  1428.  
  1429.     if {($statinfo(mode) & 0170000) == 0120000} {
  1430.       set filetype l
  1431.       catch {file readlink "$k"} linkname
  1432.       if {[file isdirectory "$k"]} {
  1433.         set filetype ld
  1434.       }
  1435.     }
  1436.  
  1437.     if {$dosorttest} {
  1438.       switch -exact $config(fileshow,sort) {
  1439.         time {
  1440.           set tmp [format "%011d" $statinfo(mtime)]
  1441.           set sortval_n  $tmp
  1442.           set sortval_d  $tmp
  1443.           set sortval_l  $tmp
  1444.           set sortval_ld $tmp
  1445.         }
  1446.         rtime {
  1447.           set tmp [format "%011d" [expr 2147483647 - $statinfo(mtime)]]
  1448.           set sortval_n  $tmp
  1449.           set sortval_d  $tmp
  1450.           set sortval_l  $tmp
  1451.           set sortval_ld $tmp
  1452.         }
  1453.         size {
  1454.           set tmp [format "%011d" $statinfo(size)]
  1455.           set sortval_n  $tmp
  1456.           set sortval_d  $tmp
  1457.           set sortval_l  $tmp
  1458.           set sortval_ld $tmp
  1459.         }
  1460.         extension {
  1461.           set tmp [file extension $k]$k
  1462.           set sortval_n  $tmp
  1463.           set sortval_d  $tmp
  1464.           set sortval_l  $tmp
  1465.           set sortval_ld $tmp
  1466.         }
  1467.       }
  1468.     }
  1469.     switch -exact $filetype {
  1470.       n  {lappend dl [list $sortval_n $k n $statinfo(size) $statinfo(mtime) $statinfo(mode) $statinfo(uid) $statinfo(gid)]}
  1471.       d  {lappend dl [list $sortval_d $k d $statinfo(size) $statinfo(mtime) $statinfo(mode) $statinfo(uid) $statinfo(gid)]}
  1472.       l  {lappend dl [list $sortval_l $k l $statinfo(size) $statinfo(mtime) $statinfo(mode) $statinfo(uid) $statinfo(gid) $linkname]}
  1473.       ld {lappend dl [list $sortval_ld $k ld $statinfo(size) $statinfo(mtime) $statinfo(mode) $statinfo(uid) $statinfo(gid) $linkname]}
  1474.     }
  1475.   }
  1476.  
  1477.   if {$noperm} {
  1478.     lappend dl [list 0 {Permission denied} n 0 0 0 0 0 ]
  1479.   }
  1480.  
  1481. # This will not correctly sort filenames with more than one word, but who cares...
  1482.   return [lsort $dl]
  1483.  
  1484. }
  1485.  
  1486.  
  1487. proc FTPDateStringToSeconds { date } {
  1488.   set r [catch {clock scan "$date"} out]
  1489.   if {!$r} {
  1490.     # Had to add heuristics here to get the correct year since it doesn't say which year in the input string
  1491.     set today [clock seconds]
  1492.     # If the date looks like it's more than two months in the future, let's subtract a year...
  1493.     if {$out > ($today+5184000)} {
  1494.       set t [clock format $out]
  1495.       set y [lindex $t end]
  1496.       incr y -1
  1497.       set t "[lrange $t 0 [expr [llength $t]-3]] $y"
  1498.       set r [catch {clock scan $t} out2]
  1499.       if {!$r} {
  1500.         set out $out2
  1501.       }
  1502.     }
  1503.     return $out
  1504.   }
  1505.   set r [catch {clock scan "[lindex $date 1] [lindex $date 0] [lindex $date 2]"} out]
  1506.   if {$r} {return 0}
  1507.   return "$out"
  1508. }
  1509.  
  1510. # From a file-list (GetDirlist) construct a list suitable for displaying in the
  1511. # listbox
  1512. proc ConstructFileList { dirlist } {
  1513.   set fl {}
  1514.   foreach k $dirlist {
  1515.     set type [lindex $k 2]
  1516.     switch $type {
  1517.       l   {
  1518.         lappend fl [format "%-26s %7d %s %s %s -> %s " " [lindex $k 1]@" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1519.                         "[GetStringFromMode [lindex $k 5]]" "[GetUidGidString [lindex $k 6] [lindex $k 7]]" \
  1520.                         "[lindex $k 8]" ]
  1521.       }
  1522.       ld  {
  1523.         lappend fl [format "%-26s %7d %s %s %s -> %s " "   [lindex $k 1]@/" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1524.                         "[GetStringFromMode [lindex $k 5]]" "[GetUidGidString [lindex $k 6] [lindex $k 7]]" \
  1525.                         "[lindex $k 8]" ]
  1526.       }
  1527.       d   {
  1528.         lappend fl [format "%-26s %7d %s %s %s " "   [lindex $k 1]/" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1529.                         "[GetStringFromMode [lindex $k 5]]" "[GetUidGidString [lindex $k 6] [lindex $k 7]]"  ]
  1530.       }
  1531.       n   {
  1532.         lappend fl [format "%-26s %7d %s %s %s " " [lindex $k 1]" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1533.                         "[GetStringFromMode [lindex $k 5]]" "[GetUidGidString [lindex $k 6] [lindex $k 7]]"  ]
  1534.       }
  1535.       fl  {
  1536.         lappend fl [format "%-26s %7d %s %s %s -> %s " " [lindex $k 1]@" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1537.                         "[lindex $k 5]" "[lindex $k 6]/[lindex $k 7]" \
  1538.                         "[lindex $k 8]" ]
  1539.       }
  1540.       fld {
  1541.         lappend fl [format "%-26s %7d %s %s %s -> %s " "   [lindex $k 1]@/" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1542.                         "[lindex $k 5]" "[lindex $k 6]/[lindex $k 7]" \
  1543.                         "[lindex $k 8]" ]
  1544.       }
  1545.       fd  {
  1546.         lappend fl [format "%-26s %7d %s %s %s " "   [lindex $k 1]/" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1547.                         "[lindex $k 5]" "[lindex $k 6]/[lindex $k 7]"  ]
  1548.       }
  1549.       fn  {
  1550.         lappend fl [format "%-26s %7d %s %s %s " " [lindex $k 1]" "[lindex $k 3]" "[GetTimeFromSecs [lindex $k 4]]" \
  1551.                         "[lindex $k 5]" "[lindex $k 6]/[lindex $k 7]"  ]
  1552.       }
  1553.     }
  1554.   }
  1555.   return $fl
  1556. }
  1557.  
  1558. proc InitWindows {} {
  1559.   UpdateWindow both
  1560. }
  1561.  
  1562. proc Back { inst } {
  1563.   global glob
  1564.   while { 1 } {
  1565.     set dir [lindex $glob($inst,dirstack) 0]
  1566.     if  {$dir != ""} {
  1567.       if {$dir == $glob($inst,pwd)} {
  1568.         if {[llength $glob($inst,dirstack)] == 1} break
  1569.         set glob($inst,dirstack) [lrange $glob($inst,dirstack) 1 end]
  1570.         continue
  1571.       }
  1572.       set glob($inst,dirstack) [lrange $glob($inst,dirstack) 1 end]
  1573.       NewPwd $inst $dir
  1574.       UpdateWindow $inst
  1575.       break
  1576.     }
  1577.     error "Internal error, dir is null"
  1578.     break
  1579.   }
  1580.   #puts "back: $glob(left,dirstack)\n$glob(right,dirstack)\n"
  1581. }
  1582.  
  1583. proc UpdateWindow { inst } {
  1584.   global glob
  1585.   if {$glob(async)} return
  1586.   switch $inst {
  1587.     left  { UpdateWindow_ left 0            }
  1588.     right { UpdateWindow_ right 0           }
  1589.     both  { UpdateWindow_ left 0
  1590.             if {$glob(left,pwd) == $glob(right,pwd)} {
  1591.               UpdateWindow_ right 1
  1592.             } else {
  1593.               UpdateWindow_ right 0
  1594.             }
  1595.           }
  1596.   }
  1597.   UpdateStat
  1598. }
  1599.  
  1600. proc UpdateWindow_ { inst quick } {
  1601.   global glob
  1602.  
  1603.   if {![IsFTP $glob($inst,pwd)]} {
  1604.     set glob($inst,df) [GetDF $glob($inst,pwd)]
  1605.   } else {
  1606.     set glob($inst,df) ?
  1607.   }
  1608.  
  1609.   if { [IsFTP $glob(${inst},pwd)] && (!$glob(forceupdate)) } {
  1610.     if {$glob(${inst},update_oldpwd) == $glob(${inst},pwd)} {
  1611.       $glob(win,$inst).entry_dir delete 0 end
  1612.       $glob(win,$inst).entry_dir insert end $glob(${inst},pwd)
  1613.       return ""
  1614.     }
  1615.   }
  1616.  
  1617.   # next line for autoupdater
  1618.   if {$quick} {
  1619.     set glob($inst,lastmtime) $glob([Opposite $inst],lastmtime)
  1620.   } else {
  1621.     catch {set glob($inst,lastmtime) [file mtime $glob($inst,pwd)]}
  1622.   }
  1623.  
  1624.   set oldy [lindex [$glob(win,$inst).frame_listb.listbox1 yview] 0]
  1625.   set oldlist $glob(${inst},filelist)
  1626.   if {$quick} {
  1627.     set r 0
  1628.     set glob(${inst},filelist) $glob([Opposite $inst],filelist)
  1629.   } else {
  1630.     set r [catch {GetDirList $glob(${inst},pwd)} glob(${inst},filelist)]
  1631.   }
  1632.   if {$r != 0} {
  1633.     PopError "Updating $inst panel: Error reading directory $glob(${inst},pwd) : $glob(${inst},filelist)"
  1634.     NewPwd $inst /
  1635.     set r [catch {GetDirList $glob(${inst},pwd)} glob(${inst},filelist)]
  1636.     if {$r != 0} {
  1637.       PopError "Fatal error: Cannot change to root directory. DON'T PANIC"
  1638.       CleanUp 1
  1639.     }
  1640.   }
  1641.  
  1642.   $glob(win,$inst).entry_dir delete 0 end
  1643.   $glob(win,$inst).entry_dir insert end $glob(${inst},pwd)
  1644.  
  1645.   if {$oldlist == $glob(${inst},filelist) && (!$glob(forceupdate))} {
  1646.     set glob(${inst},update_oldpwd) $glob(${inst},pwd)
  1647.     return
  1648.   }
  1649.  
  1650.   $glob(win,$inst).frame_listb.listbox1 delete 0 end
  1651.   if {$quick} {
  1652.     eval $glob(win,$inst).frame_listb.listbox1 insert end [$glob(win,[Opposite ${inst}]).frame_listb.listbox1 get 0 end]
  1653.   } else {
  1654.     eval $glob(win,$inst).frame_listb.listbox1 insert end [ConstructFileList $glob(${inst},filelist)]
  1655.   }
  1656.   if {$glob(${inst},update_oldpwd) == $glob(${inst},pwd)} {
  1657.     $glob(win,$inst).frame_listb.listbox1 yview moveto $oldy
  1658.   }
  1659.   set glob(${inst},update_oldpwd) $glob(${inst},pwd)
  1660. }
  1661.  
  1662. proc GotoNewDir { inst { ask 0 } } {
  1663.   global glob
  1664.   if {$ask} {
  1665.     set newdir [EntryDialog "New $inst dir?" "New $inst directory?" "" question]
  1666.   } else {
  1667.     set newdir [$glob(win,$inst).entry_dir get]
  1668.   }
  1669.   if {$newdir == ""} return
  1670.   DoProtCmd {
  1671.     NewPwd ${inst} $newdir
  1672.     UpdateWindow ${inst}
  1673.   }
  1674.   focus .
  1675. }
  1676.  
  1677. proc ToggleSelectEntry { inst y } {
  1678.   global glob
  1679.   set index [$glob(win,$inst).frame_listb.listbox1 nearest $y]
  1680.   if {[$glob(win,$inst).frame_listb.listbox1 selection includes $index]} {
  1681.     $glob(win,$inst).frame_listb.listbox1 selection clear $index
  1682.     set glob(listbox,last) clear
  1683.     set glob(listbox,last,idx) $index
  1684.   } else {
  1685.     $glob(win,$inst).frame_listb.listbox1 selection set $index
  1686.     set glob(listbox,last) set
  1687.     set glob(listbox,last,idx) $index
  1688.   }
  1689. }
  1690.  
  1691. proc ToggleSelectEntryMotion { inst y } {
  1692.   global glob
  1693.   # For some reason, sometimes the ToggleSelectEntry function does not get called before this....
  1694.   if {[info exists glob(listbox,last)]} {
  1695.     set index [$glob(win,$inst).frame_listb.listbox1 nearest $y]
  1696.     $glob(win,$inst).frame_listb.listbox1 selection $glob(listbox,last) $glob(listbox,last,idx) $index 
  1697.   }
  1698. }
  1699.  
  1700. proc InitBindings {} {
  1701.   global config glob
  1702.  
  1703.   foreach inst {left right} {
  1704.     bind $glob(win,$inst).entry_dir <Return> "GotoNewDir $inst;break"
  1705.     bind $glob(win,$inst).entry_dir <KP_Enter> "GotoNewDir $inst;break"
  1706.     bind $glob(win,$inst).entry_dir <3> "GotoNewDir $inst 1;break" 
  1707.     bind $glob(win,$inst).entry_dir <Escape> " 
  1708.       DoProtCmd \"UpdateWindow ${inst}\"
  1709.       focus .
  1710.     "
  1711.     bind $glob(win,$inst).frame_listb.listbox1 <2> "
  1712.       ToggleSelectEntry ${inst} %y
  1713.       break
  1714.     "
  1715.     bind $glob(win,$inst).frame_listb.listbox1 <B2-Motion> "
  1716.       ToggleSelectEntryMotion ${inst} %y
  1717.       break
  1718.     "
  1719.     bind $glob(win,$inst).frame_listb.listbox1 <3> "
  1720.       DoBut3 ${inst} \[lindex \$glob(${inst},filelist) \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
  1721.     "
  1722.     bind $glob(win,$inst).frame_listb.listbox1 <Double-1> "
  1723.       DoBut3 ${inst} \[lindex \$glob(${inst},filelist) \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
  1724.     "
  1725.     bind $glob(win,$inst).frame_listb.listbox1 <Control-3> "
  1726.       DoBut3Ctrl ${inst} \[lindex \$glob(${inst},filelist) \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
  1727.     "
  1728.     bind $glob(win,$inst).frame_listb.listbox1 <Control-Double-1> "
  1729.       DoBut3Ctrl ${inst} \[lindex \$glob(${inst},filelist) \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
  1730.     "
  1731.     bind $glob(win,$inst).frame_listb.listbox1 <ButtonRelease-1> "+UpdateStat"
  1732.     bind $glob(win,$inst).frame_listb.listbox1 <ButtonRelease-2> "+UpdateStat"
  1733.     if {$config(keyb_support)} {
  1734.       bind $glob(win,$inst).frame_listb.listbox1 <Any-1> "+focus $glob(win,$inst).frame_listb.listbox1"
  1735.       bind $glob(win,$inst).frame_listb.listbox1 <Escape> "focus ."
  1736.       bind $glob(win,$inst).frame_listb.listbox1 <Left> "DoProtCmd \" 
  1737.           NewPwd $inst \\\$glob(${inst},pwd)/..
  1738.           UpdateWindow $inst\"
  1739.           catch \"focus $glob(win,$inst).frame_listb.listbox1\"
  1740.           $glob(win,$inst).frame_listb.listbox1 activate 0
  1741.           break
  1742.         "
  1743.       bind $glob(win,$inst).frame_listb.listbox1 <Right> "
  1744.           DoProtCmd CmdView
  1745.           catch \"focus $glob(win,$inst).frame_listb.listbox1\"
  1746.           $glob(win,$inst).frame_listb.listbox1 activate 0
  1747.           break
  1748.         "
  1749.       bind $glob(win,$inst).frame_listb.listbox1 <KeyPress> "DoCommandOnKey $inst %A"
  1750.     }
  1751.   }
  1752.   if {!$config(keyb_support)} {
  1753.     bind . <KeyPress> "
  1754.       ShowListOnKey %A
  1755.     "
  1756.   }
  1757. }
  1758.  
  1759. proc DoCommandOnKey { inst key } {
  1760.   global glob
  1761.   if {$key == ""} return
  1762.   if {$key == "\r"} {
  1763.     DoProtCmd "CmdView"
  1764.     catch "focus $glob(win,$inst).frame_listb.listbox1"
  1765.     return
  1766.   }
  1767.   foreach k [lrange $glob(cmds,list) 1 end] {
  1768.     if {$key == [lindex $k 2]} {
  1769.       DoProtCmd "[lindex $k 1]"
  1770.       catch "focus $glob(win,$inst).frame_listb.listbox1"
  1771.       return
  1772.     }
  1773.   }
  1774.  
  1775.   LogStatusOnly "Cannot recognize keyboard shortcut $key"
  1776. }
  1777.  
  1778. proc UpdateStat { } {
  1779.   UpdateStat_ left
  1780.   UpdateStat_ right
  1781. }
  1782.  
  1783. proc UpdateStat_ { inst } {
  1784.   global glob
  1785.   set n 0
  1786.   set s 0
  1787.   set oldena $glob(enableautoupdate)
  1788.   set glob(enableautoupdate) 0
  1789.   foreach k [$glob(win,$inst).frame_listb.listbox1 curselection] {
  1790.     set e [lindex $glob($inst,filelist) $k]
  1791.     incr s [lindex $e 3]
  1792.     incr n
  1793.   }
  1794.   if {$s > 1048576} {
  1795.     set s [format "%.1fM" [expr $s/1048576.0]]
  1796.   }
  1797.   set len [llength $glob($inst,filelist)]
  1798.   set glob(enableautoupdate) $oldena
  1799.   $glob(win,$inst).top.t.stat configure -text "$n/$len = $s   $glob($inst,df)"
  1800. }
  1801.  
  1802.  
  1803. proc ToggleSelect { inst } {
  1804.   global glob
  1805.   if {[$glob(win,$inst).frame_listb.listbox1 curselection] != {}} { 
  1806.     $glob(win,$inst).frame_listb.listbox1 selection clear 0 end
  1807.   } else {
  1808.     $glob(win,$inst).frame_listb.listbox1 selection set 0 end
  1809.   }
  1810.   UpdateStat
  1811. }
  1812.  
  1813.  
  1814. proc ShowListOnKey { char } {
  1815.   global glob
  1816.   if {$char == ""} return
  1817.   set foc [focus]
  1818.   switch -glob $foc {
  1819.     *entry* return
  1820.   }
  1821.   ShowListOnKey_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) "$char"
  1822.   ShowListOnKey_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) "$char"
  1823. }
  1824.  
  1825. proc ShowListOnKey_ { listb_name filelist_var frompwd topwd char } {
  1826.   global glob
  1827.   upvar $filelist_var filelist
  1828.   set first ""
  1829.   set last ""
  1830.   if {[$listb_name curselection] != ""} {
  1831.     if {[string match \[A-Za-z0-9\] $char]} {
  1832.       set n 0
  1833.       foreach k $filelist {
  1834.         #puts "[string index [lindex $k 1] 0] == $char"
  1835.         if {[string index [lindex $k 1] 0] == "$char" && [IsFile $k]} {
  1836.           if {$first == ""} {
  1837.             set first $n
  1838.           }
  1839.           set last $n
  1840.         } 
  1841.         incr n
  1842.       }
  1843.       if {$last != ""} {
  1844.         $listb_name see $last
  1845.       }
  1846.       if {$first != ""} {
  1847.         $listb_name see $first
  1848.       }
  1849.     }
  1850.   }
  1851. }
  1852.  
  1853. proc IsFile { elem } {
  1854.   switch [lindex $elem 2] {
  1855.     l -
  1856.     n -
  1857.     fl -
  1858.     fn { return 1 } 
  1859.   }
  1860.   return 0
  1861. }
  1862.  
  1863.  
  1864. #-----------------------------------------------------------------------------
  1865.  
  1866. # If you understand how these functions work, let me know. I haven't got
  1867. # the slighest idea anymore :-)
  1868.  
  1869. proc CdMenuCreate { inst curdir menuwid level } {
  1870.   global glob config
  1871.   #puts "CdMenuCreate curdir: \'$curdir\'"
  1872.   if { [string range $curdir 0 1] == "//" } {
  1873.     set curdir [string range $curdir 1 end]
  1874.   }
  1875.   if { [IsFTP $curdir] } {
  1876.     set curdir /
  1877.   }
  1878.   set r [catch {cd $curdir} outp]
  1879.   if {$r != 0} {
  1880.     $menuwid delete 0 end
  1881.     if { [IsFTP $curdir] } {
  1882.       $menuwid add command -label "Not implemented for FTP"
  1883.     } else {
  1884.       $menuwid add command -label $outp
  1885.     }
  1886.     return ""
  1887.   }
  1888.   set r [catch {pwd} curdir]
  1889.   if {$r} {
  1890.     $menuwid delete 0 end
  1891.     $menuwid add command -label $curdir
  1892.     return ""
  1893.   }
  1894.   if {$config(fileshow,all)} {
  1895.     set r [catch {glob -nocomplain .*/ */} outp]
  1896.   } else {
  1897.     set r [catch {glob -nocomplain */} outp]
  1898.   }
  1899.   if {$r} {
  1900.     $menuwid delete 0 end
  1901.     $menuwid add command -label $outp
  1902.     return ""
  1903.   }
  1904.  
  1905.   set menulist [lsort $outp]
  1906.   if {!$config(fileshow,all)} {
  1907.     set menulist [linsert $menulist 0 ..]
  1908.   }
  1909.  
  1910.   $menuwid delete 0 end
  1911.   if { $level == 1 } { 
  1912.     $menuwid add command -label / -command "CdMenuCommand $inst /"
  1913.   }
  1914.  
  1915.   foreach dir $menulist {
  1916.     #puts "Adding cdmenucommand $curdir/$dir"
  1917.     $menuwid add command -label $dir -command "CdMenuCommand $inst [Esc $curdir/$dir]"
  1918.   }
  1919.  
  1920.   bind $menuwid <Map> "CdMenuCreateCasc $inst [Esc $curdir] %W $level [list $menulist]"
  1921.   bind $menuwid <Unmap> { %W.0 unpost }
  1922. }
  1923.  
  1924. proc CdMenuCreateCasc { inst curdir menuwid level menulist } {
  1925.   global glob
  1926.   #puts "CdMenuCreateCasc curdir: \'$curdir\'"
  1927.   set n 0
  1928.   if {[winfo exists $menuwid.0]} {
  1929.     destroy $menuwid.0
  1930.   }
  1931.   menu $menuwid.0 -tearoff false
  1932.  
  1933.   if {$level == 1} {
  1934.     if {[winfo exists $menuwid.0.$n]} {
  1935.       destroy $menuwid.0.$n
  1936.     }
  1937.     menu $menuwid.0.$n -tearoff false -postcommand "CdMenuCreate $inst / $menuwid.0.$n [expr $level+1]"
  1938.     $menuwid.0 add cascade -menu $menuwid.0.$n
  1939.     incr n
  1940.   }
  1941.   foreach dir $menulist {
  1942.     if {[winfo exists $menuwid.0.$n]} {
  1943.       destroy $menuwid.0.$n
  1944.     }
  1945.     menu $menuwid.0.$n -tearoff false -postcommand "CdMenuCreate $inst [Esc $curdir/$dir] $menuwid.0.$n [expr $level+1]"
  1946.     $menuwid.0 add cascade -menu $menuwid.0.$n
  1947.     incr n
  1948.   }
  1949.   $menuwid.0 post [expr [winfo rootx $menuwid] + [winfo width $menuwid] - 26] [winfo rooty $menuwid]
  1950. }
  1951.  
  1952. proc CdMenuCommand { inst dir } {
  1953.   global glob
  1954.   #puts "CdMenuCommand dir \'$dir\'"
  1955.   destroy $glob(win,$inst).dirmenu_frame.dir_but.m
  1956.   menu $glob(win,$inst).dirmenu_frame.dir_but.m -tearoff false -postcommand \
  1957.       "eval CdMenuCreate $inst \[Esc \$glob($inst,pwd)\] $glob(win,$inst).dirmenu_frame.dir_but.m 1"
  1958.   #update idletasks
  1959.   DoProtCmd "NewPwd $inst [Esc $dir] ; UpdateWindow $inst"
  1960. }
  1961.  
  1962.  
  1963. #-----------------------------------------------------------------------------
  1964.  
  1965.  
  1966.  
  1967. proc DoBut3 { inst fileelem } {
  1968.   DoProtCmd_NoGrab "DoBut3_ $inst \$fileelem"
  1969. }
  1970.  
  1971. proc DoBut3_ { inst fileelem } {
  1972.   global glob env config
  1973.   switch [lindex $fileelem 2] {
  1974.     fd  -
  1975.     fld -
  1976.     ld  - 
  1977.     d   { NewPwd $inst $glob($inst,pwd)/[lindex $fileelem 1]
  1978.           UpdateWindow $inst
  1979.         }
  1980.     fn  -
  1981.     fl  {
  1982.           set r [regexp {ftp://([^/]*)(.*)} $glob($inst,pwd) match ftpI directory]
  1983.           if {$r == 0} { 
  1984.             PopError "Can't parse $glob($inst,pwd) as ftp URL" 
  1985.           } else { 
  1986.             set r 0
  1987.             if { ! [file exists $glob(tmpdir)] } {
  1988.               set r [Try { file mkdir $glob(tmpdir) } "" 1]
  1989.             }
  1990.             if { !$r } {
  1991.               set size [lindex $fileelem 3]
  1992.               if {[lindex $fileelem 2] == "fl"} {set size -1}
  1993.               set r [Try { FTP_GetFile $ftpI "$directory/[lindex $fileelem 1]" "$glob(tmpdir)/[lindex $fileelem 1]" $size 0 } "" 1]
  1994.               if {$r == 0} { ViewAny $glob(tmpdir)/[lindex $fileelem 1]; set glob(havedoneftp) 1 }
  1995.             }
  1996.           }
  1997.         }
  1998.     n   -
  1999.     l   {
  2000.           ViewAny [list "$glob($inst,pwd)/[lindex $fileelem 1]"]
  2001.         }
  2002.   }
  2003. }
  2004.  
  2005. proc Opposite { inst } {
  2006.   if {$inst == "left" } {return right}
  2007.   if {$inst == "right" } {return left}
  2008.   error "Internal error ($inst)"
  2009. }
  2010.  
  2011. proc DoBut3Ctrl { inst fileelem } {
  2012.   DoProtCmd_NoGrab "DoBut3Ctrl_ $inst \{$fileelem\}"
  2013. }
  2014.  
  2015. proc DoBut3Ctrl_ { inst fileelem } {
  2016.   global glob
  2017.   switch [lindex $fileelem 2] {
  2018.     fd  -
  2019.     fld -
  2020.     ld  - 
  2021.     d   { NewPwd [Opposite $inst] $glob($inst,pwd)/[lindex $fileelem 1]
  2022.           UpdateWindow [Opposite $inst]
  2023.         }
  2024.   }
  2025. }
  2026.  
  2027. proc CheckAbort { info } {
  2028.   global glob
  2029.   update
  2030.   if { $glob(abortcmd) } {
  2031.     Log "$info aborted"
  2032.     #set glob(abortcmd) 0
  2033.     return 1
  2034.   }
  2035.   return 0
  2036. }
  2037.  
  2038. proc CantDoThat { } {
  2039.   PopInfo "It would be cool if FileRunner could do that, but it can't (yet)..."
  2040. }
  2041.  
  2042.  
  2043.  
  2044. proc DoUsrCmd { proc } {
  2045.   global glob
  2046.   set r [DoUsrCmd_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) $proc]
  2047.   if {$r} {
  2048.     UpdateWindow both
  2049.     return
  2050.   }
  2051.   set r [DoUsrCmd_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) $proc]
  2052.   if {$r} {
  2053.     UpdateWindow both
  2054.     return
  2055.   }
  2056.   Try { $proc "" $glob(right,pwd) $glob(left,pwd) $glob(mbutton) } "" 1
  2057.   UpdateWindow both
  2058. }
  2059.  
  2060. proc DoUsrCmd_ { listb_name filelist_var frompwd topwd proc } {
  2061.   global config glob
  2062.   upvar $filelist_var filelist
  2063.  
  2064.   set fl {}
  2065.   foreach sel [$listb_name curselection] {
  2066.     if {[CheckAbort "UserCommand $proc"]} return
  2067.     set elem [lindex $filelist $sel]
  2068.     lappend fl [lindex $elem 1]
  2069.   }
  2070.   if {$fl == ""} {return 0}
  2071.   Try { $proc $fl $frompwd $topwd $glob(mbutton) } "" 1
  2072.   return 1
  2073. }
  2074.  
  2075. proc CheckWhoOwns { file action } {
  2076.   global config
  2077.   if {!$config(check_ownership)} {return 1}
  2078.   set r [CheckOwner $file]
  2079.   if {$r} {return 1}
  2080.   set r [tk_dialog_fr .apop "!" "$file is not owned by you. OK to go ahead and try to $action anyway?" "" 1 "Yes" "No"]
  2081.   if {$r == 0} {return 1}
  2082.   return 0
  2083. }
  2084.  
  2085.  
  2086. proc NewPwd { inst newpwd } { 
  2087.   global glob config
  2088.  
  2089.   while { 1 } {
  2090.     if { [string range $newpwd 0 1] == "//" } {
  2091.       set newpwd [string range $newpwd 1 end]
  2092.     }
  2093.  
  2094.     set tmp1 [string range $newpwd 0 5]
  2095.     set tmp2 [string range $glob(${inst},newpwd_oldpwd) 0 5]
  2096.     if { $tmp1 == "ftp://" } {
  2097.       set mode ftp
  2098.  
  2099.       set r [regexp {ftp://([^/]*)(.*)} $newpwd match ftpI newpwd2]
  2100.       if {$r != 0 && $ftpI != "" && $newpwd2 == ""} { set newpwd2 / }
  2101.       if {$r == 0 || $ftpI == "" || $newpwd2 == ""} { 
  2102.         set newpwd [EntryDialog "Error in path" "Malformed URL $newpwd\nFormat: ftp://<site>/<path>\nPlease edit new path or cancel." $newpwd warning]
  2103.         if {$newpwd == ""} return ""
  2104.         continue
  2105.       }
  2106.  
  2107.       set r [catch {OpenFTP $ftpI} out]
  2108.       if {$r} { 
  2109.         if {$out == "ABORT_FTP_LOGIN_PLEASE" } {
  2110.           LogStatusOnly "FTP login aborted"
  2111.           return ""
  2112.         }
  2113.         set newpwd [EntryDialog "Error connecting" "Error: $out\n\nPlease edit new path or cancel." $newpwd warning]
  2114.         if {$newpwd == ""} return
  2115.         continue
  2116.       }
  2117.  
  2118.       set r [catch {FTP_CD $ftpI "$newpwd2"} out]
  2119.       if {$r} { 
  2120.         set newpwd [EntryDialog "Error in path" "Error: $out\nPlease edit new path or cancel. If you want to create it, press Create." $newpwd warning 1]
  2121.         # The following is in order to make sure the connection to the FTP site is not lost even though we didn't get
  2122.         # the initial path correct.
  2123.         set r [catch {FTP_PWD $ftpI} out]
  2124.         if {!$r} {
  2125.           set glob(${inst},pwd) ftp://$ftpI$out
  2126.           if {$newpwd == ""} break
  2127.         }
  2128.         if {$newpwd == ""} return
  2129.         continue
  2130.       }
  2131.  
  2132.       if {$config(ftp,cd_pwd)} {
  2133.         set r [catch {FTP_PWD $ftpI} out]
  2134.         if {!$r} {
  2135.           set glob(${inst},pwd) ftp://$ftpI$out
  2136.         } else {
  2137.           PopError "$out"
  2138.           return
  2139.         }
  2140.       } else {
  2141.         # Evaluate xxx/yyy/zzz/../.. to xxx
  2142.         while {[regexp -- {/\.\.$} $newpwd2]} {
  2143.           set newpwd2 [file dirname [file dirname $newpwd2]]
  2144.         }
  2145.         set glob(${inst},pwd) ftp://$ftpI$newpwd2
  2146.       }
  2147.       break
  2148.     } else {
  2149.       set mode normal
  2150.       set r [catch {cd "$newpwd"} out]
  2151.       if {$r} { 
  2152.         set newpwd [EntryDialog "Error in path" "Error: $out\nPlease edit new path or cancel. If you want to create it, press Create." $newpwd warning 1]
  2153.         if {$newpwd == ""} return ""
  2154.         continue
  2155.       }
  2156.       if {$config(cd_pwd) || ([string index $newpwd 0] != "/")} {
  2157.         set r [catch {Pwd} out]
  2158.         if {$r} { 
  2159.           PopError "Trying to get directory info: $out"
  2160.           return "" 
  2161.         }
  2162.         set glob(${inst},pwd) $out
  2163.       } else {
  2164.         # Evaluate xxx/yyy/zzz/../.. to xxx
  2165.         while {[regexp -- {/\.\.$} $newpwd]} {
  2166.           set newpwd [file dirname [file dirname $newpwd]]
  2167.         }
  2168.         set glob(${inst},pwd) $newpwd
  2169.       }
  2170.       break
  2171.     }
  2172.   }
  2173.  
  2174.   if { $tmp2 == "ftp://" } {
  2175.     set r [regexp {ftp://([^/]*)(.*)} $glob(${inst},newpwd_oldpwd) match ftpI newpwd]
  2176.     if { $r == 0 } { PopError "Malformed URL $glob(${inst},newpwd_oldpwd) (fatal)"; CleanUp 0 }
  2177.     CloseFTP $ftpI
  2178.   }
  2179.  
  2180.   set glob(${inst},newpwd_oldpwd) $glob(${inst},pwd)
  2181.  
  2182.   AppendToDirHistory $glob(${inst},pwd)
  2183.  
  2184.   set glob($inst,dirstack) [linsert $glob($inst,dirstack) 0 $glob(${inst},pwd)]
  2185.   if { [llength $glob($inst,dirstack)] > 110 } {
  2186.     set glob($inst,dirstack) [lrange $glob($inst,dirstack) 0 100]
  2187.   }
  2188.   #puts "back: $glob(left,dirstack)\n$glob(right,dirstack)\n"
  2189. }
  2190.  
  2191. proc AppendToDirHistory {dir} {
  2192.   global glob
  2193.   set found_index [lsearch -exact $glob(history) $dir]  
  2194.   if { $found_index == -1 } { 
  2195.     lappend glob(history) $dir
  2196.     set listlength [llength $glob(history)]
  2197.     if { $listlength > 32 } {
  2198.       set glob(history) [lrange $glob(history) [expr $listlength - 30] end ]
  2199.     }
  2200.     #puts "$glob(history)"
  2201.   } elseif { $found_index >= 0 } {
  2202.     set list1 [lrange $glob(history) 0 [expr $found_index-1] ]
  2203.     set list2 [lrange $glob(history) [expr $found_index+1] end]
  2204.     set glob(history) [concat $list1 $list2]
  2205.     lappend glob(history) $dir
  2206.   }
  2207. }
  2208.  
  2209. proc CreateHistoryMenu { inst } {
  2210.   global glob
  2211.   set menun $glob(win,$inst).dirmenu_frame.history_but.m 
  2212.   $menun delete 0 end
  2213.   foreach dir $glob(history) {
  2214.     $menun add command -label "$dir" -command "CdHistory ${inst} \{$dir\}"
  2215.   }
  2216. }
  2217.  
  2218. proc CdHistory { inst dir } {
  2219.   global glob
  2220.   DoProtCmd "
  2221.     NewPwd ${inst} \{$dir\}
  2222.     UpdateWindow ${inst}
  2223.   "
  2224. }
  2225.  
  2226.  
  2227. proc CreateHotListMenu { inst } {
  2228.   global glob
  2229.   set menun $glob(win,$inst).dirmenu_frame.hotlist_but.m
  2230.  
  2231.   $menun delete 0 end
  2232.   $menun add command -label "Add to hotlist" -command "AddToHotList \"\$glob($inst,pwd)\""
  2233.   $menun add separator
  2234.   set n 0
  2235.   foreach dir $glob(hotlist) {
  2236.     if { [lindex $dir 1] != "" } {
  2237.       if { [string index [lindex $dir 0] 0] == "-" } {
  2238.         # submenu
  2239.         catch {destroy $menun.$n}
  2240.         menu $menun.$n -tearoff false
  2241.         foreach sub [lrange $dir 1 end] {
  2242.           if { [lindex $sub 1] != "" } {
  2243.             $menun.$n add command -label "[lindex $sub 0]" -command "CdHotList $inst \{[lindex $sub 1]\}"
  2244.           } else {
  2245.             $menun.$n add command -label "$sub" -command "CdHotList $inst \{$sub\}"
  2246.           }
  2247.         }
  2248.         $menun add cascade -menu $menun.$n -label "[string range [lindex $dir 0] 1 end]"
  2249.         incr n
  2250.       } else {
  2251.         # commented menu
  2252.         $menun add command -label "[lindex $dir 0]" -command "CdHotList $inst \{[lindex $dir 1]\}"
  2253.       }
  2254.     } else {
  2255.       $menun add command -label "$dir" -command "CdHotList $inst \{$dir\}"
  2256.     }
  2257.   }
  2258. }
  2259.  
  2260. proc CdHotList { inst dir } {
  2261.   DoProtCmd "
  2262.     NewPwd $inst \{$dir\}
  2263.     UpdateWindow $inst
  2264.   "
  2265. }
  2266.  
  2267. proc AddToHotList { currentpwd } {
  2268.   global glob
  2269.   if {[lindex $currentpwd 1] != ""} {
  2270.     set currentpwd [list $currentpwd $currentpwd]
  2271.   }
  2272.   #puts "$currentpwd"
  2273.   lappend glob(hotlist) $currentpwd
  2274. }
  2275.  
  2276.  
  2277.  
  2278. #proc pvar { name element op } {
  2279. #  if { $element != "" } {
  2280. #    set name ${name} ($element)
  2281. #  }
  2282. #  upvar $name x
  2283. #  puts "Variable $name set to $x"
  2284. #}
  2285.  
  2286. proc ViewText { filename } {
  2287.   set r [catch {open $filename r} fid]
  2288.   if {$r != 0} {
  2289.     PopError "$fid"
  2290.     return
  2291.   }
  2292.   set r [catch {read -nonewline $fid} content]
  2293.   if {$r != 0} {
  2294.     PopError "$content"
  2295.     catch {close $fid}
  2296.     return
  2297.   }
  2298.   close $fid
  2299.   ViewString "Viewing $filename" content $filename
  2300. }
  2301.  
  2302. proc ViewString { title var_string filename } {
  2303.   global glob config
  2304.   upvar $var_string string
  2305.  
  2306.   incr glob(toplevelidx)  
  2307.  
  2308.   set w .toplevel_$glob(toplevelidx)
  2309.   toplevel $w
  2310.   wm title $w "$title"
  2311.   wm iconname $w "$title"
  2312.   wm geometry $w $config(geometry,textviewer)
  2313.   text $w.text -relief sunken -bd 2 -yscrollcommand "$w.fr.scroll set" -setgrid 1 \
  2314.       -height 30 -font $config(gui,font) -background $config(gui,color_bg) \
  2315.       -foreground $config(gui,color_fg) -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg) -highlightthickness 0 
  2316.   frame $w.fr -borderwidth 0
  2317.   scrollbar $w.fr.scroll -command "$w.text yview" 
  2318.   button $w.fr.quit -bitmap @$glob(lib_fr)/bitmaps/cross.bit -command "destroy $w" -width 1 -height 11 -bd 1
  2319.   pack $w.fr.scroll -side bottom -fill y -expand 1
  2320.   pack $w.fr.quit -side top -fill x
  2321.   pack $w.fr -side right -fill y
  2322.   pack $w.text -expand yes -fill both
  2323.   $w.text insert 0.0 $string
  2324.   $w.text mark set insert 0.0
  2325.   menu $w.text.p
  2326.   $w.text.p add command -label Search... -command "SearchView $w.text 0"
  2327.   $w.text.p add command -label {Search Again} -command "SearchView $w.text 1"
  2328.   $w.text.p add command -label {Save As...} -command "SaveToFile $w.text [Esc $filename] 1"
  2329.   $w.text.p add command -label Quit -command "destroy $w"
  2330.   bind $w.text <3> "tk_popup $w.text.p %X %Y"
  2331.   bind $w <Escape> "destroy $w"
  2332.   bind $w <Next> "$w.text yview scroll 1 pages"
  2333.   bind $w <Prior> "$w.text yview scroll -1 pages"
  2334.   bind $w <Home> "$w.text see 0.0"
  2335.   bind $w <End> "$w.text see end"
  2336.   bind $w.text $config(mwheel,neg) "$w.text yview scroll -$config(mwheel,delta) units"
  2337.   bind $w.text $config(mwheel,pos) "$w.text yview scroll $config(mwheel,delta) units"
  2338.  
  2339.   #catch {focus $w.text}
  2340.   #tkwait window $w
  2341. }
  2342.  
  2343. proc SaveToFile { w filename ask } {
  2344.   global env
  2345.   if {$ask} {
  2346.     if {$filename == ""} {set filename $env(HOME)/}
  2347.     set filename [EntryDialog "What file?" "Enter name of file to save to" $filename question]
  2348.     if {$filename == ""} return
  2349.   } else {
  2350.     if {$filename == ""} {PopError "Null filename"}
  2351.   }
  2352.   Log "Saving to $filename"
  2353.   Try { set fid [open $filename w]
  2354.         puts -nonewline $fid [$w get 0.0 end]
  2355.         close $fid} "" 1
  2356. }
  2357.  
  2358.  
  2359. proc SearchView { w again } {
  2360.   global glob config
  2361.   if {!$again} {
  2362.     set s [EntryDialog "Search..." "Enter text to search for" $glob(searchstring) question]
  2363.     if {$s == ""} return
  2364.     set glob(searchstring) $s
  2365.     $w mark set insert 0.0
  2366.   }
  2367.  
  2368.   set tag select
  2369.   $w tag configure $tag -background $config(gui,color_select_bg) -foreground $config(gui,color_select_fg) 
  2370.   $w tag remove $tag 0.0 end
  2371.   set idx [$w search -count len -nocase -- $glob(searchstring) insert]
  2372.   if {$idx == ""} {
  2373.     PopInfo "$glob(searchstring) not found"
  2374.     return
  2375.   }
  2376.   $w tag add $tag $idx "$idx + $len chars"
  2377.   $w mark set insert "$idx + $len chars"
  2378.   $w see insert
  2379. }
  2380.  
  2381.  
  2382. proc EditText { filename scriptWhenDone } {
  2383.   global glob config
  2384.   incr glob(toplevelidx)  
  2385.  
  2386.   set w .toplevel_$glob(toplevelidx)
  2387.   toplevel $w
  2388.   wm title $w "Editing $filename"
  2389.   wm iconname $w "Editing $filename"
  2390.   wm protocol $w WM_DELETE_WINDOW "EditTextCheckPoint [Esc $filename] $w \"$scriptWhenDone\""
  2391.   wm geometry $w $config(geometry,qedit)
  2392.  
  2393.   text $w.text -relief sunken -bd 2 -yscrollcommand "$w.fr.scroll set" -setgrid 1 \
  2394.     -highlightthickness 0 -height 30 -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  2395.   frame $w.fr -borderwidth 0
  2396.   scrollbar $w.fr.scroll -command "$w.text yview" 
  2397.   button $w.fr.quit -bitmap @$glob(lib_fr)/bitmaps/cross.bit -command "EditTextCheckPoint [Esc $filename] $w \"$scriptWhenDone\"" \
  2398.       -width 1 -height 11 -bd 1
  2399.   pack $w.fr.scroll -side bottom -fill y -expand 1
  2400.   pack $w.fr.quit -side top -fill x
  2401.   pack $w.fr -side right -fill y
  2402.   pack $w.text -expand yes -fill both
  2403.   set fid [open $filename r]
  2404.   $w.text insert 0.0 [read -nonewline $fid]
  2405.   close $fid
  2406.   set size_file [file size $filename]
  2407.   set size_text [string length [$w.text get 0.0 end]]
  2408.   if { $size_file != $size_text } {
  2409.     PopWarn "Editing:\nCharacters lost/added when converting $filename to text.\nOld size: $size_file\nNew Size: $size_text"
  2410.   }
  2411.   $w.text mark set insert 0.0
  2412.   menu $w.text.p
  2413.   $w.text.p add command -label Search... -command "SearchView $w.text 0"
  2414.   $w.text.p add command -label {Search Again} -command "SearchView $w.text 1"
  2415.   $w.text.p add command -label {Save} -command "SaveToFile $w.text [Esc $filename] 0"
  2416.   $w.text.p add command -label {Save As...} -command "SaveToFile $w.text [Esc $filename] 1"
  2417.   $w.text.p add command -label {Save&Quit} -command "SaveEditedText [Esc $filename] $w \"$scriptWhenDone\""
  2418.   $w.text.p add command -label Quit -command "destroy $w"
  2419.   bind $w.text <3> "tk_popup $w.text.p %X %Y"
  2420.   bind $w <Escape> "EditTextCheckPoint [Esc $filename] $w \"$scriptWhenDone\""
  2421.   bind $w <Next> "$w.text yview scroll 1 pages"
  2422.   bind $w <Prior> "$w.text yview scroll -1 pages"
  2423.   bind $w <Home> "$w.text see 0.0"
  2424.   bind $w <End> "$w.text see end"
  2425.   bind $w.text $config(mwheel,neg) "$w.text yview scroll -$config(mwheel,delta) units"
  2426.   bind $w.text $config(mwheel,pos) "$w.text yview scroll $config(mwheel,delta) units"
  2427. }
  2428.  
  2429. proc EditTextCheckPoint { filename w scriptWhenDone } {
  2430.   set r [tk_dialog .editq {What to do?} {Do you want to save before exiting?} {} 0 Yes No Cancel]
  2431.   switch $r {
  2432.     0 { SaveEditedText $filename $w $scriptWhenDone }
  2433.     1 { catch { destroy $w } }
  2434.     default {}
  2435.   }
  2436. }
  2437.  
  2438. proc SaveEditedText { filename w scriptWhenDone } {
  2439.   Log "Text editor: Saving $filename"
  2440.   Try { set fid [open $filename w]
  2441.         puts -nonewline $fid [$w.text get 0.0 end]
  2442.         close $fid} "" 1
  2443.   catch {destroy $w}
  2444.   UpdateWindow both
  2445.   if {$scriptWhenDone != ""} {
  2446.     eval $scriptWhenDone
  2447.   }
  2448. }
  2449.  
  2450. proc EntryDialog { wm_title info_text start_entry {icon ""} {createdir 0}} {
  2451.   global glob config
  2452.  
  2453.   set w .entry_dialog
  2454.   toplevel $w -class Dialog
  2455.   wm title $w $wm_title
  2456.   wm iconname $w $wm_title
  2457.   wm resizable $w true false
  2458.   wm transient $w [winfo toplevel [winfo parent $w]]
  2459.  
  2460.   frame $w.bot
  2461.   entry $w.entry -highlightthickness 1 -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -width 70 -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  2462.   $w.entry delete 0 end
  2463.   $w.entry insert end $start_entry
  2464.  
  2465.   set text_length [string length $info_text]
  2466.   set info_text [string range $info_text 0 1000]
  2467.   if {$text_length > [string length $info_text]} {
  2468.     set info_text "$info_text\n\n...etc..."
  2469.   }
  2470.  
  2471.   label $w.bot.info_text -justify left -text "$info_text"  -wraplength 5i
  2472. #  label $w.info_text -justify left -text "$info_text\nReturn activates, escape or window-delete cancels."
  2473.  
  2474.   button $w.bot.ok -text OK -command { 
  2475.     set glob(entry_dialog_return) [.entry_dialog.entry get]
  2476.     destroy .entry_dialog
  2477.   }
  2478.   button $w.bot.cancel -text Cancel -command { 
  2479.     set glob(entry_dialog_return) {}
  2480.     set glob(abortcmd) 1
  2481.     destroy .entry_dialog
  2482.   }
  2483.  
  2484.   pack $w.bot -side bottom -expand 1 -fill x
  2485.   pack $w.bot.cancel -side right -anchor s
  2486.   pack $w.bot.ok -side right -anchor s
  2487.  
  2488.   if {$createdir} {
  2489.     button $w.bot.create -text Create -command { 
  2490.       set glob(entry_dialog_return) [.entry_dialog.entry get]
  2491.       set r [regexp {ftp://([^/]*)(.*)} $glob(entry_dialog_return) match ftpI dir]
  2492.       if {$r} {
  2493.         Try { FTP_MkDir $ftpI "$dir" } "" 1
  2494.       } else {
  2495.         Try { file mkdir $glob(entry_dialog_return) } "" 1
  2496.       }
  2497.       destroy .entry_dialog
  2498.     }
  2499.     pack $w.bot.create -side right -anchor s
  2500.   }
  2501.  
  2502.   if {$icon != ""} {
  2503.     label $w.bot.icon -bitmap $icon 
  2504.     pack $w.bot.icon -side left -padx 20 -anchor n -pady 2
  2505.   }
  2506.   pack $w.bot.info_text -side left -fill x -expand 1 -anchor w
  2507.  
  2508. #-padx 8 -pady 5
  2509.  
  2510.   pack $w.entry -side bottom -padx 8 -pady 8 -expand 1 -fill x
  2511.  
  2512.   set glob(entry_dialog_return) {}
  2513.  
  2514.   bind $w.entry <Return> {
  2515.     set glob(entry_dialog_return) [.entry_dialog.entry get]
  2516.     destroy .entry_dialog
  2517.   }
  2518.  
  2519.   bind $w.entry <KP_Enter> {
  2520.     set glob(entry_dialog_return) [.entry_dialog.entry get]
  2521.     destroy .entry_dialog
  2522.   }
  2523.  
  2524.   bind $w.entry <Escape> {
  2525.     set glob(entry_dialog_return) {}
  2526.     set glob(abortcmd) 1
  2527.     destroy .entry_dialog
  2528.   }
  2529.  
  2530.   wm withdraw $w
  2531.   update idletasks
  2532.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  2533.           - [winfo vrootx [winfo parent $w]]]
  2534.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  2535.           - [winfo vrooty [winfo parent $w]]]
  2536.   wm geom $w +$x+$y
  2537.   wm deiconify $w
  2538.  
  2539.   set oldFocus [focus]
  2540.   set oldGrab [grab current $w]
  2541.   frgrab $w
  2542.   focus $w.entry
  2543.   set oldena $glob(enableautoupdate)
  2544.   set glob(enableautoupdate) 0
  2545.   tkwait window $w
  2546.   catch {focus $oldFocus}
  2547.   if {$oldGrab != ""} {
  2548.     frgrab $oldGrab
  2549.   }
  2550.   set glob(enableautoupdate) $oldena
  2551.   return $glob(entry_dialog_return)
  2552. }
  2553.  
  2554. proc FTPEntryDialog { wm_title info_text start_entry } {
  2555.   global glob config
  2556.  
  2557.   set w .ftp_entry_dialog
  2558.   toplevel $w -class Dialog
  2559.   wm title $w $wm_title
  2560.   wm iconname $w $wm_title
  2561.   wm resizable $w true false
  2562.   wm transient $w [winfo toplevel [winfo parent $w]]
  2563.  
  2564.   label $w.info_text -justify left -text "$info_text\n\nReturn activates, escape or window-delete cancels."
  2565.   pack "$w.info_text" -anchor w -side top -padx 8 -pady 5
  2566.  
  2567.   label $w.us -text Username:
  2568.   pack $w.us -side top -anchor w -padx 8
  2569.  
  2570.   entry $w.entry -highlightthickness 1 -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -width 70 -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  2571.   $w.entry delete 0 end
  2572.   $w.entry insert end $start_entry
  2573.   pack $w.entry -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x
  2574.  
  2575.   label $w.pw -text Password:
  2576.   pack $w.pw -side top -anchor w -padx 8
  2577.  
  2578.   entry $w.entry2 -highlightthickness 1 -show "*" -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -width 70 -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  2579.   $w.entry2 delete 0 end
  2580.   $w.entry2 insert end ""
  2581.   pack $w.entry2 -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x
  2582.  
  2583.   set glob(ftp_entry_dialog_return) {}
  2584.  
  2585.   bind $w.entry <Return> {
  2586.     set glob(ftp_entry_dialog_return) " [.ftp_entry_dialog.entry get] [.ftp_entry_dialog.entry2 get] "
  2587.     destroy .ftp_entry_dialog
  2588.   }
  2589.  
  2590.   bind $w.entry <Escape> {
  2591.     set glob(ftp_entry_dialog_return) {}
  2592.     destroy .ftp_entry_dialog
  2593.   }
  2594.  
  2595.   bind $w.entry2 <Return> {
  2596.     set glob(ftp_entry_dialog_return) " [.ftp_entry_dialog.entry get] [.ftp_entry_dialog.entry2 get] "
  2597.     destroy .ftp_entry_dialog
  2598.   }
  2599.  
  2600.   bind $w.entry2 <Escape> {
  2601.     set glob(ftp_entry_dialog_return) {}
  2602.     destroy .ftp_entry_dialog
  2603.   }
  2604.  
  2605.   wm withdraw $w
  2606.   update idletasks
  2607.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  2608.           - [winfo vrootx [winfo parent $w]]]
  2609.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  2610.           - [winfo vrooty [winfo parent $w]]]
  2611.   wm geom $w +$x+$y
  2612.   wm deiconify $w
  2613.  
  2614.   set oldFocus [focus]
  2615.   set oldGrab [grab current $w]
  2616.   frgrab $w
  2617.   focus $w.entry
  2618.   set oldena $glob(enableautoupdate)
  2619.   set glob(enableautoupdate) 0
  2620.   tkwait window $w
  2621.   catch {focus $oldFocus}
  2622.   if {$oldGrab != ""} {
  2623.     frgrab $oldGrab
  2624.   }
  2625.   set glob(enableautoupdate) $oldena
  2626.   return $glob(ftp_entry_dialog_return)
  2627. }
  2628.  
  2629. proc EntryDialogDouble { wm_title info_text1 info_text2 info_text3 start_entry1 start_entry2 } {
  2630.   global glob config
  2631.  
  2632.   set w .tk_dialog_double
  2633.   toplevel $w -class Dialog
  2634.   wm title $w $wm_title
  2635.   wm iconname $w $wm_title
  2636.   wm resizable $w true false
  2637.   wm transient $w [winfo toplevel [winfo parent $w]]
  2638.  
  2639.   label $w.info_text -justify left -text $info_text1 -wraplength 7i
  2640.   pack $w.info_text -anchor w -side top -padx 8 -pady 5
  2641.  
  2642.   entry $w.entry -highlightthickness 1 -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -width 70 -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  2643.   $w.entry delete 0 end
  2644.   $w.entry insert end $start_entry1
  2645.   pack $w.entry -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x
  2646.  
  2647.   label $w.info_text2 -text $info_text2 -justify left -wraplength 7i
  2648.   pack $w.info_text2 -side top -anchor w -padx 8 -pady 5
  2649.  
  2650.   entry $w.entry2 -highlightthickness 1 -show "*" -font $config(gui,font) -background $config(gui,color_bg) -foreground $config(gui,color_fg) -width 70 -selectbackground $config(gui,color_select_bg) -selectforeground $config(gui,color_select_fg)
  2651.   $w.entry2 delete 0 end
  2652.   $w.entry2 insert end $start_entry2
  2653.   pack $w.entry2 -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x
  2654.  
  2655.   label $w.info_text3 -text $info_text3 -justify left -wraplength 7i
  2656.   pack $w.info_text3 -side top -anchor w -padx 8 -pady 5
  2657.  
  2658.   button $w.ok -text OK -command {
  2659.     set glob(tk_dialog_double_return) [list [.tk_dialog_double.entry get] [.tk_dialog_double.entry2 get]]
  2660.     destroy .tk_dialog_double
  2661.   }
  2662.  
  2663.   button $w.cancel -text Cancel -command {
  2664.     set glob(tk_dialog_double_return) {}
  2665.     destroy .tk_dialog_double
  2666.   }
  2667.  
  2668.   pack $w.cancel -side right
  2669.   pack $w.ok -side right
  2670.  
  2671.   set glob(tk_dialog_double_return) {}
  2672.  
  2673.   bind $w.entry <Return> {
  2674.     set glob(tk_dialog_double_return) [list [.tk_dialog_double.entry get] [.tk_dialog_double.entry2 get]]
  2675.     destroy .tk_dialog_double
  2676.   }
  2677.  
  2678.   bind $w.entry <Escape> {
  2679.     set glob(tk_dialog_double_return) {}
  2680.     destroy .tk_dialog_double
  2681.   }
  2682.  
  2683.   bind $w.entry2 <Return> {
  2684.     set glob(tk_dialog_double_return) [list [.tk_dialog_double.entry get] [.tk_dialog_double.entry2 get]]
  2685.     destroy .tk_dialog_double
  2686.   }
  2687.  
  2688.   bind $w.entry2 <Escape> {
  2689.     set glob(tk_dialog_double_return) {}
  2690.     destroy .tk_dialog_double
  2691.   }
  2692.  
  2693.   wm withdraw $w
  2694.   update idletasks
  2695.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  2696.           - [winfo vrootx [winfo parent $w]]]
  2697.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  2698.           - [winfo vrooty [winfo parent $w]]]
  2699.   wm geom $w +$x+$y
  2700.   wm deiconify $w
  2701.  
  2702.   set oldFocus [focus]
  2703.   set oldGrab [grab current $w]
  2704.   frgrab $w
  2705.   focus $w.entry
  2706.   set oldena $glob(enableautoupdate)
  2707.   set glob(enableautoupdate) 0
  2708.   tkwait window $w
  2709.   catch {focus $oldFocus}
  2710.   if {$oldGrab != ""} {
  2711.     frgrab $oldGrab
  2712.   }
  2713.   set glob(enableautoupdate) $oldena
  2714.   return $glob(tk_dialog_double_return)
  2715. }
  2716.  
  2717. proc ViewAny { filenamelist } {
  2718.   global glob config
  2719.   set firstfile [lindex $filenamelist 0]
  2720.   set found ""
  2721.   foreach k $config(view,extensions) {
  2722.     foreach l [lindex $k 1] {
  2723.       if {[string match [string tolower $l] [string tolower "$firstfile"]]} {
  2724.         set found $k
  2725.         break
  2726.       }
  2727.     }
  2728.     if {$found != ""} break
  2729.   }
  2730.   if {$found != ""} {
  2731.     if {[lindex $k 2] == "-viewtext"} {
  2732.       foreach file $filenamelist {
  2733.         catch { eval eval exec [format [lindex $k 0] [Esc $file]] } out
  2734.         ViewString "Viewing $file" out ""
  2735.       }
  2736.     } else {
  2737.       # list needs to be escaped...
  2738.       foreach f $filenamelist {
  2739.         lappend f2 [Esc $f]
  2740.       }
  2741.       Try {eval eval eval exec [format [lindex $k 0] $f2] &} "" 1
  2742.     }
  2743.     return
  2744.   }
  2745.   foreach filename $filenamelist {
  2746.     ViewText "$filename"
  2747.   }
  2748. }
  2749.  
  2750.  
  2751. proc UnArcAny { file dir } {
  2752.   global config glob
  2753.   set found ""
  2754.   foreach k $config(cmd,unarc,extensions) {
  2755.     foreach l [lindex $k 1] {
  2756.       if {[string match [string tolower $l] [string tolower "$file"]]} {
  2757.         set found $k
  2758.         break
  2759.       }
  2760.     }
  2761.     if {$found != ""} break
  2762.   }
  2763.   if {$found == ""} {
  2764.     PopWarn "Cannot find unarchive rule for $file"
  2765.     return
  2766.   }
  2767.   Try { cd $dir; eval eval exec [format [lindex $k 0] [Esc $file]] } "" 1 $glob(async)
  2768. }
  2769.  
  2770. proc UnPackAny { file } {
  2771.   global config glob
  2772.   set found ""
  2773.   foreach k $config(cmd,unpack,extensions) {
  2774.     foreach l [lindex $k 1] {
  2775.       if {[string match [string tolower $l] [string tolower "$file"]]} {
  2776.         set found $k
  2777.         break
  2778.       }
  2779.     }
  2780.     if {$found != ""} break
  2781.   }
  2782.   if {$found == ""} {
  2783.     PopWarn "Cannot find unpack rule for $file"
  2784.     return
  2785.   }
  2786.   Try { eval eval exec [format [lindex $k 0] [Esc $file]] } "" 1 $glob(async)
  2787. }
  2788.  
  2789. proc TabBind { list } {
  2790.   set i [lsearch -exact $list [focus]]
  2791.   incr i
  2792.   if {$i >= [llength $list]} {
  2793.     set i 0
  2794.   }
  2795.   catch {focus [lindex $list $i]} out
  2796. }
  2797.  
  2798.  
  2799. proc PopInfo { info } {
  2800.   tk_dialog_fr .apop "Info" "$info" "" 0 "OK"
  2801.   #LogSilent "**Info**\n$info"
  2802. }
  2803.  
  2804. proc PopWarn { warn } {
  2805.   tk_dialog_fr .apop "Warning" "$warn" "" 0 "OK"
  2806.   LogStatusOnly "[lindex [split $warn \n] 0]"
  2807.   LogSilent "**Warning**\n$warn"
  2808. }
  2809.  
  2810. proc PopError { error } {
  2811.   tk_dialog_fr .apop "**Error**" "$error" "" 0 "OK"
  2812.   LogStatusOnly "[lindex [split $error \n] 0]"
  2813.   LogSilent "**Error**\n$error"
  2814. }
  2815.  
  2816. proc PopErrorSimple { error } {
  2817.   tk_dialog .apop "**Error**" "$error" "" 0 "OK"
  2818. }
  2819.  
  2820. proc Try { tryscript excuse alsoPrintErrorInfo {async 0} } {
  2821.   #puts "Try:$tryscript"
  2822.   if {$async} {
  2823.     # Currently the try function can only background commands that use the built-in exec
  2824.     if {[string match "*exec*" $tryscript]} {
  2825.       set tryscript "$tryscript &"
  2826.     }
  2827.   }
  2828.   set r [catch {uplevel $tryscript} outp ]
  2829.   if {$r == 0} {return 0}
  2830.  
  2831.   # This is a really ugly hack, but I don't care... I can't see another way around this. Email me if you got a solution.
  2832.   # (Problem shows up in Linux when unarchiving .tar.gz files and the error is completely harmless)
  2833.   if {$outp == "child killed: write on pipe with no readers"} {
  2834.     return 0
  2835.   }
  2836.  
  2837.   if {$alsoPrintErrorInfo} {
  2838.     if {$excuse != ""} {
  2839.       PopError "$excuse\n$outp"
  2840.     } else {
  2841.       PopError "$outp"
  2842.     }
  2843.   } else {
  2844.     PopError "$excuse"
  2845.   }
  2846.  
  2847.   return 1
  2848. }
  2849.  
  2850. proc tk_dialog_fr {w title text bitmap default args} {
  2851.   global tkPriv config glob
  2852.  
  2853.   # 1. Create the top-level window and divide it into top
  2854.   # and bottom parts.
  2855.  
  2856.   catch {destroy $w}
  2857.   toplevel $w -class Dialog
  2858.   wm title $w $title
  2859.   wm iconname $w Dialog
  2860.   wm protocol $w WM_DELETE_WINDOW { }
  2861.   wm transient $w [winfo toplevel [winfo parent $w]]
  2862.   frame $w.top -relief raised -bd 1
  2863.   pack $w.top -side top -fill both
  2864.   frame $w.bot -relief raised -bd 1
  2865.   pack $w.bot -side bottom -fill both
  2866.  
  2867.   # 2. Fill the top part with bitmap and message (use the option
  2868.   # database for -wraplength so that it can be overridden by
  2869.   # the caller).
  2870.  
  2871.   #option add *Dialog.msg.wrapLength 3i widgetDefault
  2872.   set text_length [string length $text]
  2873.   set text [string range $text 0 1000]
  2874.   if {$text_length > [string length $text]} {
  2875.     set text "$text\n\n...etc..."
  2876.   }
  2877.   label $w.msg -justify left -text $text \
  2878.       -font $config(gui,font) -wraplength 700
  2879.   #-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
  2880.   pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  2881.   if {$bitmap != ""} {
  2882.     label $w.bitmap -bitmap $bitmap
  2883.     pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  2884.   }
  2885.  
  2886.   # 3. Create a row of buttons at the bottom of the dialog.
  2887.  
  2888.   set i 0
  2889.   foreach but $args {
  2890.     button $w.button$i -text $but -command "set tkPriv(button) $i"
  2891.     if {$i == $default} {
  2892.       frame $w.default -relief sunken -bd 1
  2893.       raise $w.button$i $w.default
  2894.       pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
  2895.       pack $w.button$i -in $w.default -padx 2m -pady 2m
  2896.       bind $w <Return> "$w.button$i flash; set tkPriv(button) $i"
  2897.     } else {
  2898.       pack $w.button$i -in $w.bot -side left -expand 1 \
  2899.           -padx 3m -pady 2m
  2900.     }
  2901.     incr i
  2902.   }
  2903.  
  2904.   # 4. Withdraw the window, then update all the geometry information
  2905.   # so we know how big it wants to be, then center the window in the
  2906.   # display and de-iconify it.
  2907.  
  2908.   wm withdraw $w
  2909.   update idletasks
  2910.   set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  2911.              - [winfo vrootx [winfo parent $w]]]
  2912.   set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  2913.              - [winfo vrooty [winfo parent $w]]]
  2914.   wm geom $w +$x+$y
  2915.   wm deiconify $w
  2916.  
  2917.   # 5. Set a grab and claim the focus too.
  2918.  
  2919.   set oldFocus [focus]
  2920.   set oldGrab [grab current $w]
  2921.   if {$oldGrab != ""} {
  2922.     set grabStatus [grab status $oldGrab]
  2923.   }
  2924.   frgrab $w
  2925.   if {$default >= 0} {
  2926.     focus $w.button$default
  2927.   } else {
  2928.     focus $w
  2929.   }
  2930.  
  2931.   # 6. Wait for the user to respond, then restore the focus and
  2932.   # return the index of the selected button.  Restore the focus
  2933.   # before deleting the window, since otherwise the window manager
  2934.   # may take the focus away so we can't redirect it.  Finally,
  2935.   # restore any grab that was in effect.
  2936.  
  2937.   set oldena $glob(enableautoupdate)
  2938.   set glob(enableautoupdate) 0
  2939.   tkwait variable tkPriv(button)
  2940.   set glob(enableautoupdate) $oldena
  2941.   catch {focus $oldFocus}
  2942.   destroy $w
  2943.   if {$oldGrab != ""} {
  2944.     frgrab $oldGrab
  2945.   }
  2946.   return $tkPriv(button)
  2947. }
  2948.  
  2949. proc StartTerm { dir inst } {
  2950.   global config
  2951.   Try { cd $dir; eval exec $config(cmd,term) & } "" 1
  2952. }
  2953.  
  2954. # Make sure link is open, don't open it if it is already open
  2955. proc OpenFTP { ftpI } {
  2956.   global glob config env
  2957.   set ftpIleft ""
  2958.   set ftpIright ""
  2959.   set rl [regexp {ftp://([^/]*)(.*)} $glob(left,pwd) match ftpIleft directory]
  2960.   set rr [regexp {ftp://([^/]*)(.*)} $glob(right,pwd) match ftpIright directory]
  2961.   if {$ftpIleft == $ftpI || $ftpIright == $ftpI} {
  2962.     # Link already open
  2963.     return ""
  2964.   }
  2965.   Log "Opening FTP connection to $ftpI"
  2966.  
  2967.   # first see if we can find a match in the config(ftp,site_usage) rule list
  2968.   foreach k $config(ftp,login) {
  2969.     if {[string match [lindex $k 0] $ftpI]} {
  2970.       set user [lindex [lindex $k 1] 0]
  2971.       set passwd [lindex [lindex $k 1] 1]
  2972.       set proxy [lindex $k 2]
  2973.       if {$passwd == "XXX"} {
  2974.         set t [FTPEntryDialog "FTP Login" "Connecting to $ftpI: Please enter password" $user]
  2975.         if {$t == ""} {
  2976.           error "ABORT_FTP_LOGIN_PLEASE"
  2977.         }
  2978.         set passwd [lindex $t 1]
  2979.       }
  2980.       if { $user == "" } {
  2981.         set user $config(ftp,user)
  2982.       }
  2983.       if { $passwd == "" } {
  2984.         set passwd $config(ftp,password)
  2985.       }
  2986.       if { $proxy != "" } {
  2987.         FTP_OpenSession $ftpI $proxy $user@$ftpI $passwd $ftpI
  2988.         set glob(ftp,$ftpI,host) $proxy
  2989.         set glob(ftp,$ftpI,passwd) $passwd
  2990.         set glob(ftp,$ftpI,user) $user@$ftpI
  2991.       } else {
  2992.         FTP_OpenSession $ftpI $ftpI $user $passwd $ftpI
  2993.         set glob(ftp,$ftpI,host) $ftpI
  2994.         set glob(ftp,$ftpI,passwd) $passwd
  2995.         set glob(ftp,$ftpI,user) $user
  2996.       }
  2997.       Log "FTP connection to $ftpI open"
  2998.       return
  2999.     }
  3000.   }
  3001.   set user $config(ftp,user)
  3002.   set passwd $config(ftp,password)
  3003.   if { !$config(ftp,anonymous) } {
  3004.     set t [FTPEntryDialog "FTP Login" "Connecting to $ftpI: Please enter username and password" $env(USER)]
  3005.     if {$t == ""} {
  3006.       error "ABORT_FTP_LOGIN_PLEASE"
  3007.     }
  3008.     set user [lindex $t 0]
  3009.     set passwd [lindex $t 1]
  3010.     if { $user == "" } {
  3011.       set user $config(ftp,user)
  3012.     }
  3013.     if { $passwd == "" } {
  3014.       set passwd $config(ftp,password)
  3015.     }
  3016.   }
  3017.   if { $config(ftp,proxy) != "" && $config(ftp,useproxy)} {
  3018.     FTP_OpenSession $ftpI $config(ftp,proxy) $user@$ftpI $passwd $ftpI
  3019.     set glob(ftp,$ftpI,host) $config(ftp,proxy)
  3020.     set glob(ftp,$ftpI,passwd) $passwd
  3021.     set glob(ftp,$ftpI,user) $user@$ftpI
  3022.   } else {
  3023.     FTP_OpenSession $ftpI $ftpI $user $passwd $ftpI
  3024.     set glob(ftp,$ftpI,host) $ftpI
  3025.     set glob(ftp,$ftpI,passwd) $passwd
  3026.     set glob(ftp,$ftpI,user) $user
  3027.   }
  3028.   Log "FTP connection to $ftpI open"
  3029. }
  3030.  
  3031.  
  3032.  
  3033. proc ShowRev { } {
  3034.   global glob env
  3035.   set r [catch {source $glob(conf_dir)/version} out]
  3036.   if {$r} {
  3037.     set version 0.0
  3038.   }
  3039.   if {$glob(version) != $version} {
  3040.     About
  3041.     if {$version != "0.0"} {
  3042.       ViewText $glob(lib_fr)/HISTORY
  3043.     }
  3044.     set r [catch {
  3045.       set fid [open $glob(conf_dir)/version w]
  3046.       puts $fid "set version $glob(version)"
  3047.       close $fid
  3048.     }]
  3049.     if {$r} {
  3050.       PopWarn "Cannot create $glob(conf_dir)/version"
  3051.     }
  3052.   }
  3053. }
  3054.  
  3055. # Make sure link is closed, don't close if in use
  3056. proc CloseFTP { ftpI } {
  3057.   global glob config
  3058.   set ftpIleft ""
  3059.   set ftpIright ""
  3060.   set rl [regexp {ftp://([^/]*)(.*)} $glob(left,pwd) match ftpIleft directory]
  3061.   set rr [regexp {ftp://([^/]*)(.*)} $glob(right,pwd) match ftpIright directory]
  3062.   if {$ftpIleft == $ftpI || $ftpIright == $ftpI} {
  3063.     # Link in use
  3064.     return ""
  3065.   }
  3066.   #Log "Closing FTP connection to $ftpI"
  3067.   Try { FTP_CloseSession $ftpI } "Could not close FTP session nicely, (non-fatal)\n" 1
  3068.   catch {unset glob(ftp,$ftpI,host)}
  3069.   catch {unset glob(ftp,$ftpI,user)}
  3070.   catch {unset glob(ftp,$ftpI,passwd)}
  3071. }
  3072.  
  3073.  
  3074. proc FindLibfr {} {
  3075.   global glob config env argv argv0
  3076.   set pname $argv0
  3077.   set r [catch { file readlink $pname } out]
  3078.   if { $r != 0 } {
  3079.     if { [string index [file dirname $pname] 0] == "/" } {
  3080.       set glob(lib_fr) [file dirname $pname]
  3081.     } else {
  3082.       set glob(lib_fr) [pwd]/[file dirname $pname]
  3083.     }
  3084.   } else {
  3085.     if { [string index [file dirname $out] 0] == "/" } {
  3086.       set glob(lib_fr) [file dirname $out]
  3087.     } else {
  3088.       if { [string index [file dirname $pname] 0] == "/" } {
  3089.         set glob(lib_fr) [file dirname $pname]/[file dirname $out]
  3090.       } else {
  3091.         set glob(lib_fr) [pwd]/[file dirname $pname]/[file dirname $out]
  3092.       }
  3093.     }
  3094.   }
  3095.   if { ! [info exists glob(doclib_fr)] } {
  3096.     set glob(doclib_fr) $glob(lib_fr)
  3097.   }
  3098. }
  3099.  
  3100. proc Log { text } {
  3101.   LogStatusOnly $text
  3102.   LogSilent $text
  3103. }
  3104.  
  3105. proc LogStatusOnly { text } {
  3106.   global glob
  3107.   $glob(win,top).status configure -text [string range $text 0 110]
  3108.   update idletasks
  3109. }
  3110.  
  3111. proc LogSilent { text } {
  3112.   global glob config
  3113.   set glob(log) "$glob(log)---[Time]---\n$text\n"
  3114.   set len [string length $glob(log)]
  3115.   if { $len > $config(logsize) } {
  3116.     set glob(log) "...[string range $glob(log) [expr $len - (($config(logsize) * 4) / 5)] end]"
  3117.   }
  3118. }
  3119.  
  3120.  
  3121. proc IsFTP { dir } {
  3122.   if { [string range $dir 0 5] == "ftp://" } {return 1}
  3123.   return 0
  3124. }
  3125.  
  3126. # Pwd should filter /tmp_mnt stuff out of the path. How well does that work? Not
  3127. proc Pwd { } {
  3128.   return [pwd]
  3129. #  set r [pwd]
  3130. #  if { [string range $r 0 7] == "/tmp_mnt" } {
  3131. #    set t [string range $r 8 end]
  3132. #    if {$t != ""} {
  3133. #      set r $t
  3134. #    }
  3135. #  }
  3136. #  return $r
  3137. }
  3138.  
  3139. proc CleanUp { ret } {
  3140.   global env config glob
  3141.   if {$glob(havedoneftp)} {
  3142.     set r [catch {glob $glob(tmpdir)/*} list]
  3143.     if {!$r && $list != "" } {
  3144.       catch { eval file delete -force -- $list } out
  3145.     }
  3146.   }
  3147.   if { $ret } { puts "FileRunner: aborting (return code $ret)" }
  3148.   # save history to disk
  3149.   set r [catch {set fid [open $glob(conf_dir)/history w];puts $fid $glob(history);close $fid} out]
  3150.   if {$r} {
  3151.     puts "FileRunner: Can't save directory history to disk: $out"
  3152.   }
  3153.   if { $config(save_conf_at_exit) && !$r && !$ret } {
  3154.     SaveConfig
  3155.   }
  3156.   exit $ret
  3157. }
  3158.  
  3159. proc Time {} {
  3160.   global config
  3161.   if { $config(dateformat) == "yymmdd" } {
  3162.     return "[clock format [clock seconds] -format %y%m%d\ %R]"
  3163.   } else {
  3164.     return "[clock format [clock seconds] -format %d%m%y\ %R]"
  3165.   }
  3166. }
  3167.  
  3168. proc TimeUpdater {} {
  3169.   global glob
  3170.   $glob(win,top).menu_frame.clock configure -text "[Time]      "
  3171.   after 30000 TimeUpdater
  3172. }
  3173.  
  3174. proc ListUpdater {} {
  3175.   global glob config
  3176.   set f [focus]
  3177.   set class ""
  3178.   if {$f != ""} {
  3179.     set class [winfo class $f]
  3180.   }
  3181.   if {$glob(enableautoupdate) && $class != "Entry"} {
  3182.     foreach inst {left right} {
  3183.       if { ! [IsFTP $glob(${inst},pwd)] } {
  3184.         set r [catch { set mtime [file mtime $glob($inst,pwd)] }]
  3185.         if {!$r} {
  3186.           if {$mtime != $glob($inst,lastmtime)} {
  3187.             LogStatusOnly "Updating $inst panel"
  3188.             DoProtCmd "UpdateWindow $inst"
  3189.             LogStatusOnly "Updating $inst panel - done"
  3190.             #set glob($inst,lastmtime) $mtime #done in updatewindow
  3191.           }
  3192.         }
  3193.       }
  3194.     }
  3195.   }
  3196.   if {$config(autoupdate)} {
  3197.     after [expr $config(autoupdate) * 1000] ListUpdater
  3198.   }
  3199. }
  3200.  
  3201. proc StartUpdaters {} {
  3202.   global glob config
  3203.   after 30000 TimeUpdater
  3204.   set glob(left,lastmtime) 0
  3205.   set glob(right,lastmtime) 0
  3206.   catch {set glob(left,lastmtime) [file mtime $glob(left,pwd)]}
  3207.   catch {set glob(right,lastmtime) [file mtime $glob(right,pwd)]}
  3208.   if {$config(autoupdate)} {
  3209.     after [expr $config(autoupdate) * 1000] ListUpdater
  3210.   }
  3211. }
  3212.  
  3213. proc frgrab { w } {
  3214.   for {set i 0} {$i < 10} {set i [expr $i + 1]} {
  3215.     set r [catch {grab $w} out]
  3216.     if {!$r} { return }
  3217.     after 50
  3218.   }
  3219.   if {$r} {
  3220.     LogStatusOnly "$out"
  3221.   }
  3222. }
  3223.  
  3224. proc CheckCmdLineArgs { } {
  3225.   global argv
  3226.   set i [lsearch -exact $argv -iconified]
  3227.   if {$i < 0} return
  3228.   wm iconify .
  3229.   set argv [concat [lrange $argv 0 [expr $i - 1]] [lrange $argv [expr $i + 1] end]]
  3230. }
  3231.  
  3232. proc ViewBatchList {} {
  3233.   global glob
  3234.   set tmp [join $glob(batchlist) \n]
  3235.   ViewString {FTP Batch List} tmp {}
  3236. }
  3237.  
  3238.  
  3239. proc AddToBatchList { inst } {
  3240.   global glob
  3241.   foreach sel [$glob(win,$inst).frame_listb.listbox1 curselection] {
  3242.     set elem [lindex $glob($inst,filelist) $sel]
  3243.     switch [lindex $elem 2] {
  3244.       fl -
  3245.       fn {
  3246.         set item [list $glob($inst,pwd)/[lindex $elem 1] [lindex $elem 3]]
  3247.         set glob(batchlist) [linsert $glob(batchlist) end $item]
  3248.       }
  3249.       default {
  3250.         PopError "You can only add FTP files to the batch"
  3251.         return
  3252.       }
  3253.     }
  3254.   }
  3255. }
  3256.  
  3257. # The purpose of this function is to take a string and escape it so it survives being passed through
  3258. # the evil eval command without changing at all. (Did I mention I hate the eval command? :-) 
  3259. # ...I just realized I hate the list command too... :-)
  3260. proc Esc { name } {
  3261.   set a [list $name]
  3262.   set len [string length $a]
  3263.   # eval doesn't handle a string ending with '\ ' very well...
  3264.   if {[string range $a [expr $len - 2] end] == {\ }} {
  3265.     set a "\"$a\""
  3266.   }
  3267.   return $a
  3268. }
  3269.  
  3270. proc CheckOwner { file } { 
  3271.   if {! [file exists $file]} {
  3272.     return 1
  3273.   }
  3274.   return [file owned $file]
  3275. }
  3276.  
  3277. # --------------------------------------STARTUP--------------------------------------------
  3278.  
  3279.  
  3280.  
  3281.  
  3282. # This test should be a wee bit more sophisticated... :-)
  3283. if { [file isdir "c:/"] } {
  3284.   set glob(os) WIN32
  3285. } else {
  3286.   set glob(os) Unix
  3287. }
  3288. set glob(init_done) 0
  3289. set glob(start_path) [pwd]
  3290.  
  3291. CheckCmdLineArgs
  3292.  
  3293. FindLibfr
  3294.  
  3295. # Load patches for 8.0...
  3296. if {$tk_patchLevel == "8.0"} {
  3297.   #puts "Buggy 8.0 menu.tcl file, applying patch"
  3298.   source $glob(lib_fr)/menu_80_patch.tcl
  3299. }
  3300.  
  3301. set auto_path [linsert $auto_path 0 $glob(lib_fr) ]
  3302.  
  3303. if { $glob(os) == "WIN32" } {
  3304.   set f ext.dll
  3305. } else {
  3306.   set f ext.so
  3307. }
  3308.  
  3309. set r [catch { load $glob(lib_fr)/$f Ext } out]
  3310. if { $r != 0 } {
  3311.   PopErrorSimple "Error loading FileRunner binary extensions code:\n\n$out"
  3312.   exit 1
  3313. }
  3314.  
  3315. if { $glob(os) == "WIN32" } {
  3316.   set glob(conf_dir) $glob(lib_fr)/userconfig
  3317. } else {
  3318.   set glob(conf_dir) $env(HOME)/.fr
  3319. }
  3320.  
  3321. set config(usercommands) ""
  3322. if { [file exists $glob(conf_dir)/cmds ] } {
  3323.   set r [catch { source $glob(conf_dir)/cmds } out]
  3324.   if { $r != 0 } {
  3325.     PopErrorSimple "Error loading code from $glob(conf_dir)/cmds:\n\n$out"
  3326.     exit 1
  3327.   }
  3328. }
  3329.  
  3330. set r [catch {package require http 2.0} out]
  3331. if {$r} {
  3332.   PopErrorSimple "Error loading HTTP package:\n\n$out"
  3333.   exit 1
  3334. }
  3335.  
  3336. unset out r f
  3337.  
  3338. FTP_InvalidateCache
  3339. CheckConfigDir
  3340. InitConfig
  3341. ReadConfig
  3342. ShowWindow
  3343. InitWindows
  3344. InitBindings
  3345. ConfigPwd
  3346. StartUpdaters
  3347. Log "Welcome to FileRunner v$glob(version). Copyright (C) 1996-1998 Henrik Harmsen."
  3348.  
  3349. ShowRev
  3350.  
  3351. set glob(init_done) 1
  3352.  
  3353.